source: FOIAVistA/trunk/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XPAREDIT.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 3.8 KB
Line 
1XPAREDIT ;SLC/KCM - Simple Parameter Editor ;11:39 PM 12 May 1998
2 ;;7.3;TOOLKIT;**26**;Apr 25, 1995
3 ;
4EN ; Enter here to select parameter, then entity
5 ; ENT: variable pointer to the entity selected
6 ; PAR: IEN^NAME of the selected parameter
7 W !,?25,"--- Edit Parameter Values ---"
8 N ENT,PAR,LST,JUST1,DIRUT,DUOUT,DTOUT
9 F W ! D GETPAR(.PAR) Q:'PAR D W !,$$DASH($S($D(IOM):IOM-1,1:78))
10 . D BLDLST(.LST,PAR)
11 . F D GETENT(.ENT,PAR,.JUST1) Q:'ENT D EDIT(ENT,PAR) Q:JUST1
12 Q
13TED(TLT,SHWFLG,ALLENT) ; Edit parameters using a template
14 G TED^XPAREDT3
15 ;
16TEDH(TLT,SHWFLG,ALLENT) ; Edit parameters using a template, show dash headers
17 G TEDH^XPAREDT3
18 ;
19TEDIT(ENT,PAR,INST,USRX) ; Edit an instance of a parameter
20 I $G(INST)="" D EDITA S USRX=$G(Y("X")) I 1
21 E D EDIT1^XPAREDT2 S USRX=$G(Y("X"))
22 I $E(USRX)=U,$E(USRX,2)'=U,$L(USRX)>1 K DTOUT,DUOUT,DIRUT
23 Q
24EDITPAR(PAR) ; Edit a single parameter
25 ; add second parameter to limit entity type? ENTTYP
26 ; LOC,CLS,TEA,USR,DIV,SVC call LOOKUP with appropriate FN
27 ; PKG,SYS figure out appropriate defaults (param nmsp, domain)
28 N ENT
29 I 'PAR S PAR=$O(^XTV(8989.51,"B",PAR,0))
30 S PAR=PAR_U_$P(^XTV(8989.51,PAR,0),U,2)
31 ; W $P(PAR,U,2)
32 D GETENT(.ENT,PAR) Q:'ENT
33 D EDIT(ENT,PAR)
34 Q
35GETPAR(Y) ; Select parameter to edit
36 N DIC,DTOUT,DUOUT,X
37 S DIC=8989.51,DIC(0)="AEMQ"
38 S DIC("W")="W "" "",$P(^(0),U,2)"
39 D ^DIC I Y<1 S Y=0
40 Q
41GETENT(ENT,PAR,JUST1) ; Select entity to edit for a given parameter
42 ; .ENT=entity, returned as variable pointer
43 ; PAR=ien^name
44 N X,I,LST
45 S JUST1=0
46 D BLDLST(.LST,PAR) S ENT=""
47 I LST=1 D ; if only one class of entity
48 . S X=LST($O(LST(0))),ENT=$P(X,U,5) ; instance for entity
49 . I ENT S JUST1=1 Q ; is fixed entry
50 . I 'ENT D LOOKUP(.ENT,+X) ; not fixed - do lookup
51 E D ; otherwise
52 . D GETCLS(.X,PAR,.LST) ; choose class
53 . I 'X S ENT="" Q ; nothing selected
54 . I +X&(X[";") S ENT=X Q ; resolved VP returned
55 . I $L($P(LST(X),U,5)) S ENT=$P(LST(X),U,5) Q ; fixed instance
56 . S ENT="" D LOOKUP(.ENT,+LST(X)) ; lookup on selected file
57 Q
58EDIT(ENT,PAR) ; Edit value(s) for entity/parameter
59 N INST,X,Y
60EDITA ; come here from TEDIT
61 N ERR,INSTLST
62 I '$D(NOHDR) W !!,$$CENTER("Setting "_$P(PAR,U,2)_" "_$$ENTDISP(ENT))
63 I +$P(^XTV(8989.51,+PAR,0),U,3) F D Q:'$L(INST)!$D(DIRUT) ; multiple
64 . I $D(NOHDR) W !!,"For "_$P(PAR,U,2)_" -"
65 . ; D SHWINST^XPAREDT2(ENT,+PAR,$S($D(IOSL):IOSL-4,1:20),0,.INSTLST)
66 . D SELINST^XPAREDT2(.INST,ENT,+PAR) Q:'$L(INST)
67 . W ! S Y="" D EDITVAL^XPAREDT2(.Y,+PAR,"I",INST) Q:(Y="")!($E(Y)=U)
68 . I Y="@" D DEL^XPAR(ENT,+PAR,$P(INST,U),.ERR) D Q
69 . . I ERR W $$ERR^XPAREDT2 Q
70 . . W " ...deleted"
71 . I $P(Y,U)'=$P(INST,U) D I ERR W $$ERR^XPAREDT2 Q
72 . . D REP^XPAR(ENT,+PAR,$P(INST,U),$P(Y,U),.ERR) S INST=Y
73 . W " ",$P(INST,U,2) D EDIT1^XPAREDT2
74 E S INST="1^1" D EDIT1^XPAREDT2 ;W ! before ; single valued
75 K ^TMP($J,"XPARWP")
76 Q
77BLDLST(LST,PAR) ; Build list of entities allowed for this parameter
78 G BLDLST^XPAREDT1
79 ;
80GETCLS(X,PAR,LST) ; Choose the class of entity
81 G GETCLS^XPAREDT1
82 ;
83LOOKUP(X,FN) ; Lookup entry in a file and return selection as varptr
84 ; if X has data, pass that into lookup silently
85 N DIC,DTOUT,DUOUT
86 S DIC=FN
87 S:$L(X) DIC(0)="M" S:'$L(X) DIC(0)="AEMQ"
88 D ^DIC I $D(DTOUT)!$D(DUOUT)!(Y<1) S X="" Q
89 S X=+Y_";"_$P($$ROOT^DILFD(FN),U,2)
90 Q
91ENTDISP(ENT) ; function - returns text descriptor of an entity
92 Q:'ENT ""
93 N X,FN
94 S FN=+$P(@(U_$P(ENT,";",2)_"0)"),U,2),X=$P(^XTV(8989.518,FN,0),U,3)
95 S X=" for "_X_": "_$$EXTPTR^XPARDD(+ENT,FN)
96 Q X
97CENTER(X) ; function - writes a centered title with dashes on either side
98 N I,MAR
99 S MAR=(($S($D(IOM):IOM,1:80)-$L(X))\2)-2
100 Q $$DASH(MAR)_" "_X_" "_$$DASH(MAR)
101DASH(N) ; function - returns N dashes
102 N X
103 S X="",$P(X,"-",N+1)=""
104 Q X
Note: See TracBrowser for help on using the repository browser.