Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XPAREDIT

XPAREDIT.m

Go to the documentation of this file.
  1. XPAREDIT ; SLC/KCM - Simple Parameter Editor ;11:15 PM 4 Feb 1998
  1. ;;7.3;TOOLKIT;**26,118**;Apr 25, 1995;Build 5
  1. ;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. EN ; Enter here to select parameter, then entity
  1. ; ENT: variable pointer to the entity selected
  1. ; PAR: IEN^NAME of the selected parameter
  1. W !,?25,"--- Edit Parameter Values ---"
  1. N ENT,PAR,LST,JUST1,DIRUT,DUOUT,DTOUT
  1. F W ! D GETPAR(.PAR) Q:'PAR D W !,$$DASH($S($D(IOM):IOM-1,1:78))
  1. . D BLDLST(.LST,PAR)
  1. . F D GETENT(.ENT,PAR,.JUST1) Q:'ENT D EDIT(ENT,PAR) Q:JUST1
  1. Q
  1. TED(TLT,SHWFLG,ALLENT) ; Edit parameters using a template
  1. G TED^XPAREDT3
  1. ;
  1. TEDH(TLT,SHWFLG,ALLENT) ; Edit parameters using a template, show dash headers
  1. G TEDH^XPAREDT3
  1. ;
  1. TEDIT(ENT,PAR,INST,USRX) ; Edit an instance of a parameter
  1. K Y
  1. I $G(INST)="" D EDITA S USRX=$G(Y("X")) I 1
  1. E D EDIT1^XPAREDT2 S USRX=$G(Y("X"))
  1. I $E(USRX)=U,$E(USRX,2)'=U,$L(USRX)>1 K DTOUT,DUOUT,DIRUT
  1. Q
  1. EDITPAR(PAR) ; Edit a single parameter
  1. ; add second parameter to limit entity type? ENTTYP
  1. ; LOC,CLS,TEA,USR,DIV,SVC call LOOKUP with appropriate FN
  1. ; PKG,SYS figure out appropriate defaults (param nmsp, domain)
  1. N ENT
  1. I 'PAR S PAR=$O(^XTV(8989.51,"B",PAR,0))
  1. S PAR=PAR_U_$P(^XTV(8989.51,PAR,0),U,2)
  1. ; W $P(PAR,U,2)
  1. D GETENT(.ENT,PAR) Q:'ENT
  1. D EDIT(ENT,PAR)
  1. Q
  1. GETPAR(Y) ; Select parameter to edit
  1. N DIC,DTOUT,DUOUT,X
  1. S DIC=8989.51,DIC(0)="AEMQ"
  1. S DIC("W")="W "" "",$P(^(0),U,2)"
  1. D ^DIC I Y<1 S Y=0
  1. Q
  1. GETENT(ENT,PAR,JUST1) ; Select entity to edit for a given parameter
  1. ; .ENT=entity, returned as variable pointer
  1. ; PAR=ien^name
  1. N X,I,LST
  1. S JUST1=0
  1. D BLDLST(.LST,PAR) S ENT=""
  1. I LST=1 D ; if only one class of entity
  1. . S X=LST($O(LST(0))),ENT=$P(X,U,5) ; instance for entity
  1. . I ENT S JUST1=1 Q ; is fixed entry
  1. . I 'ENT D LOOKUP(.ENT,+X) ; not fixed - do lookup
  1. E D ; otherwise
  1. . D GETCLS(.X,PAR,.LST) ; choose class
  1. . I 'X S ENT="" Q ; nothing selected
  1. . I +X&(X[";") S ENT=X Q ; resolved VP returned
  1. . I $L($P(LST(X),U,5)) S ENT=$P(LST(X),U,5) Q ; fixed instance
  1. . S ENT="" D LOOKUP(.ENT,+LST(X)) ; lookup on selected file
  1. Q
  1. EDIT(ENT,PAR) ; Edit value(s) for entity/parameter
  1. N INST,X,Y
  1. EDITA ; come here from TEDIT
  1. N ERR,INSTLST
  1. I '$D(NOHDR) W !!,$$CENTER("Setting "_$P(PAR,U,2)_" "_$$ENTDISP(ENT))
  1. I +$P(^XTV(8989.51,+PAR,0),U,3) F D Q:'$L(INST)!$D(DIRUT) ; multiple
  1. . I $D(NOHDR) W !!,"For "_$P(PAR,U,2)_" -"
  1. . ; D SHWINST^XPAREDT2(ENT,+PAR,$S($D(IOSL):IOSL-4,1:20),0,.INSTLST)
  1. . D SELINST^XPAREDT2(.INST,ENT,+PAR) M Y=INST Q:'$L(INST)
  1. . W ! S Y="" D EDITVAL^XPAREDT2(.Y,+PAR,"I",INST) Q:(Y="")!($E(Y)=U)
  1. . I Y="@" D DEL^XPAR(ENT,+PAR,$P(INST,U),.ERR) D Q
  1. . . I ERR W $$ERR^XPAREDT2 Q
  1. . . W " ...deleted"
  1. . I $P(Y,U)'=$P(INST,U) D I ERR W $$ERR^XPAREDT2 Q
  1. . . D REP^XPAR(ENT,+PAR,$P(INST,U),$P(Y,U),.ERR) S INST=Y
  1. . W " ",$P(INST,U,2) D EDIT1^XPAREDT2
  1. E S INST="1^1" D EDIT1^XPAREDT2 ;W ! before ; single valued
  1. K ^TMP($J,"XPARWP")
  1. Q
  1. BLDLST(LST,PAR) ; Build list of entities allowed for this parameter
  1. G BLDLST^XPAREDT1
  1. ;
  1. GETCLS(X,PAR,LST) ; Choose the class of entity
  1. G GETCLS^XPAREDT1
  1. ;
  1. LOOKUP(X,FN) ; Lookup entry in a file and return selection as varptr
  1. ; if X has data, pass that into lookup silently
  1. N DIC,DTOUT,DUOUT
  1. S DIC=FN
  1. S:$L(X) DIC(0)="M" S:'$L(X) DIC(0)="AEMQ"
  1. D ^DIC I $D(DTOUT)!$D(DUOUT)!(Y<1) S X="" Q
  1. S X=+Y_";"_$E(^DIC(FN,0,"GL"),2,999)
  1. Q
  1. ENTDISP(ENT) ; function - returns text descriptor of an entity
  1. Q:'ENT ""
  1. N X,FN
  1. S FN=+$P(@(U_$P(ENT,";",2)_"0)"),U,2),X=$P(^XTV(8989.518,FN,0),U,3)
  1. S X=" for "_X_": "_$$EXTPTR^XPARDD(+ENT,FN)
  1. Q X
  1. CENTER(X) ; function - writes a centered title with dashes on either side
  1. N I,MAR
  1. S MAR=(($S($D(IOM):IOM,1:80)-$L(X))\2)-2
  1. Q $$DASH(MAR)_" "_X_" "_$$DASH(MAR)
  1. DASH(N) ; function - returns N dashes
  1. N I,X
  1. S X="" F I=1:1:N S X=X_"-"
  1. Q X