| 1 | XPAREDIT ;SLC/KCM - Simple Parameter Editor ;11:39 PM 12 May 1998
|
|---|
| 2 | ;;7.3;TOOLKIT;**26**;Apr 25, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | EN ; 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
|
|---|
| 13 | TED(TLT,SHWFLG,ALLENT) ; Edit parameters using a template
|
|---|
| 14 | G TED^XPAREDT3
|
|---|
| 15 | ;
|
|---|
| 16 | TEDH(TLT,SHWFLG,ALLENT) ; Edit parameters using a template, show dash headers
|
|---|
| 17 | G TEDH^XPAREDT3
|
|---|
| 18 | ;
|
|---|
| 19 | TEDIT(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
|
|---|
| 24 | EDITPAR(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
|
|---|
| 35 | GETPAR(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
|
|---|
| 41 | GETENT(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
|
|---|
| 58 | EDIT(ENT,PAR) ; Edit value(s) for entity/parameter
|
|---|
| 59 | N INST,X,Y
|
|---|
| 60 | EDITA ; 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
|
|---|
| 77 | BLDLST(LST,PAR) ; Build list of entities allowed for this parameter
|
|---|
| 78 | G BLDLST^XPAREDT1
|
|---|
| 79 | ;
|
|---|
| 80 | GETCLS(X,PAR,LST) ; Choose the class of entity
|
|---|
| 81 | G GETCLS^XPAREDT1
|
|---|
| 82 | ;
|
|---|
| 83 | LOOKUP(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
|
|---|
| 91 | ENTDISP(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
|
|---|
| 97 | CENTER(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)
|
|---|
| 101 | DASH(N) ; function - returns N dashes
|
|---|
| 102 | N X
|
|---|
| 103 | S X="",$P(X,"-",N+1)=""
|
|---|
| 104 | Q X
|
|---|
