source: FOIAVistA/tag/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XPAREDT1.m@ 1796

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

initial load of FOIAVistA 6/30/08 version

File size: 3.8 KB
Line 
1XPAREDT1 ;SLC/KCM - Supporting Calls - Entities;12:16 AM 13 May 1998
2 ;;7.3;TOOLKIT;**26**;Apr 25, 1995
3 ;
4BLDLST ; ...continued from BLDLST^XPAREDIT(LST,PAR)
5 ; Build list of entities allowed for this parameter
6 ; # is precedence, 'fixed' is VP to implied instance (i.e., SYS, PKG)
7 ; .LST(#)=file number^message^order^prefix^fixed^lookup info
8 ; ("M", message) = #
9 ; ("P", prefix) = #
10 ; PAR=ien^name
11 N IEN,SEQ,FN,X K LST ; make sure LST is empty initially
12 S SEQ=0,LST=0
13 F S SEQ=$O(^XTV(8989.51,+PAR,30,"B",SEQ)) Q:'SEQ S IEN=$O(^(SEQ,0)) D
14 . S FN=$P(^XTV(8989.51,+PAR,30,IEN,0),"^",2) I FN=9.4,(DUZ(0)'["@") Q
15 . S X=^XTV(8989.518,FN,0),X=FN_U_$P(X,U,3)_U_U_$P(X,U,2)
16 . S LST=LST+1,LST(SEQ)=X
17 . S LST("M",$$UPPER($P(X,U,2)))=SEQ
18 . S LST("P",$P(X,U,4))=SEQ
19 . ; find IEN's where only one entity instance is possible
20 . I FN=9.4 D ; find package to which this parameter belongs
21 . . N PRN,PRE
22 . . S PRN=$P($G(^XTV(8989.51,+PAR,0)),"^",1) Q:'$L(PRN)
23 . . 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
24 . . Q:'$L(PRE)
25 . . S X=$O(^DIC(9.4,"C",PRE,0))
26 . . S $P(LST(SEQ),U,5)=X_";DIC(9.4,"
27 . . S $P(LST(SEQ),U,6)=$P(^DIC(9.4,X,0),"^",1)
28 . I FN=4.2 D ; find domain for this system
29 . . S X=$$KSP^XUPARAM("WHERE")
30 . . S $P(LST(SEQ),U,5)=$$FIND1^DIC(4.2,"","QX",X)_";DIC(4.2,"
31 . . S $P(LST(SEQ),U,6)=X
32 . I FN=4 D ; find division if this site not multi-divisional
33 . . S X=$$KSP^XUPARAM("INST")
34 . . I $$GET1^DIQ(4,X_",",5,"I")'="Y" D
35 . . . S $P(LST(SEQ),U,5)=X_";DIC(4,"
36 . . . S $P(LST(SEQ),U,6)=$$GET1^DIQ(4,X_",",.01)
37 . I '$L($P(LST(SEQ),U,5)) D ; otherwise...
38 . . N XPARY,XPARFN S XPARFN=FN N FN
39 . . D FILE^DID(XPARFN,"","NAME","XPARY")
40 . . S $P(LST(SEQ),U,6)=$G(XPARY("NAME"))
41 Q
42GETCLS ; ...continued from GETCLS^XPAREDIT(X,PAR,LST)
43 ; Choose the class of entity
44 ; optionally, lookup entity using variable pointer syntax (PRE.NAME)
45 ; .X=returns seq # or entity in VP format
46 ; PAR=ien^name for parameter
47 ; .LST=list from which the entity is selected
48 N TMP,DONE
49 D SHWCLS
50 S DONE=0 F D Q:DONE
51 . W !,"Enter selection: " R X:DTIME S:'$T X="^" S X=$$UPPER(X)
52 . I '$L(X)!(X="^")!(X="^^") S ENT="",DONE=1 Q
53 . I $E(X)="?" D HLPCLS I $E(X,1,2)="??" D SHWCLS ; help requested
54 . I X=" " S X=$G(^DISV(DUZ,"XPAR01",+PAR)) Q:'X ; spacebar recall
55 . I +X,$D(LST(X)) S DONE=1 Q ; # -> seq #
56 . I $D(LST("P",X)) S X=LST("P",X),DONE=1 Q ; PRE -> seq #
57 . I $D(LST("M",X)) S X=LST("M",X),DONE=1 Q ; NAME -> seq #
58 . S TMP=$O(LST("M",X))
59 . I $E(TMP,1,$L(X))=X S X=LST("M",TMP),DONE=1 Q ; PARTIAL -> seq #
60 . I $L(X,".")>1,$D(LST("P",$P(X,".",1))) D Q:DONE ; if VP syntax
61 . . S TMP=$P(X,".",2)
62 . . D LOOKUP^XPAREDIT(.TMP,+LST(LST("P",$P(X,".",1)))) ; silent lookup
63 . . I $L(TMP) S X=TMP,DONE=1 ; PRE.NAME -> VP
64 . W " ??" D HLPCLS ; invalid entry
65 I +X D
66 . W " ",$P(LST(X),U,2)," ",$P(LST(X),U,6) ; echo selection
67 . I +LST(X)=9.4 D
68 . . W !!,"Parameters set for 'Package' may be replaced if "
69 . . W $P(LST(X),U,6),!,"is installed in this account."
70 . S ^DISV(DUZ,"XPAR01",+PAR)=X
71 Q
72SHWCLS ; procedure used only by GETCLS
73 ; show entity classes appropriate for this parameter
74 N I,X
75 W !!,$P(PAR,"^",2)," may be set for the following:",!!
76 S I=0 F S I=$O(LST(I)) Q:'I S X=LST(I) D
77 . W ?5,I,?9,$P(X,"^",2),?23,$P(X,U,4),?30
78 . I $L($P(X,U,5)) W "["_$P(X,U,6)_"]",!
79 . I '$L($P(X,U,5)) W "[choose from "_$P(X,U,6)_"]",!
80 Q
81HLPCLS ; procedure used only by GETCLS
82 ; display help for entity class selection
83 W !,"Enter the number, name, or abbreviation of the selection."
84 W !,"You may also use variable pointer syntax (Example: LOC.WEST2)."
85 Q
86UPPER(X) ; function - convert lower to upper case
87 Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
Note: See TracBrowser for help on using the repository browser.