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

XPAREDT2.m

Go to the documentation of this file. 
  1. XPAREDT2 ; SLC/KCM - Supporting Calls - Instances, Values ;04/08/2003  11:22
  1.  ;;7.3;TOOLKIT;**26,35,52,74**;Apr 25, 1995
  1.  ;
  1. EDIT1 ; called only from EDIT, expects ENT,PAR,INST to be defined
  1.  N VALTYPE,X S VALTYPE=$E($G(^XTV(8989.51,+PAR,1)))
  1.  I VALTYPE="W" D  I ERR W $$ERR Q
  1.  . D GETWP^XPAR(.X,ENT,+PAR,$P(INST,U),.ERR) S:'ERR $P(X,U,2)=$G(X)
  1.  I VALTYPE'="W" D
  1.  . S X=$$GET^XPAR(ENT,+PAR,$P(INST,U),"B")
  1.  . I $L(X),$E(^XTV(8989.51,+PAR,1))="P" S X="`"_X
  1.  S Y="" D EDITVAL(.Y,+PAR,"V",.X) Q:(Y="")!($E(Y)=U)
  1.  I Y="@" D DEL^XPAR(ENT,+PAR,$P(INST,U),.ERR) D  Q
  1.  . I ERR W $$ERR Q
  1.  . W "  ...deleted"
  1.  ; I VALTYPE'="W" W "   ",$P(Y,U,2)
  1.  S Y=$P(Y,U)
  1.  D EN^XPAR(ENT,+PAR,$P(INST,U),.Y,.ERR) I ERR W $$ERR Q
  1.  Q
  1. EDITVAL(DTA,PAR,TYP,DFLT) ; edit the value for an instance or a value
  1.  ;  .DTA=internal value^external value returned, wp in DTA(n,0) nodes
  1.  ;   PAR=parameter which describes the data being edited
  1.  ;   TYP=edit type - I:instance, V:value, S:select instance
  1.  ; .DFLT=internal default value^external default value
  1.  ;       internal values are preceded by "`" if they are pointers
  1.  N DIR,SUB,TERM,WP,X
  1.  S SUB=$S(TYP="V":0,1:5),Y=""
  1.  S DIR(0)=$P($G(^XTV(8989.51,+PAR,SUB+1)),U,1,2)
  1.  S $P(DIR(0),U,1)=$P(DIR(0),U,1)_"OA"
  1.  I "P"=$E(DIR(0)) S $P(DIR(0),":",2)="AEMQZ"
  1.  I $L($G(^XTV(8989.51,+PAR,SUB+2))) S $P(DIR(0),U,3)=^(SUB+2)
  1.  I $L($G(^XTV(8989.51,+PAR,SUB+3))) S DIR("S")=^(SUB+3)
  1.  I (TYP="I")!(TYP="S") S TERM=$P($G(^XTV(8989.51,+PAR,0)),U,4)
  1.  I TYP="V" S TERM=$P($G(^XTV(8989.51,+PAR,0)),U,5)
  1.  I '$L(TERM) S TERM=$S(TYP="V":"Value",1:"Instance")
  1.  S DIR("A")=$S(TYP="S":"Select ",1:"")_TERM_": "
  1.  I $L($G(DFLT)) S DIR("B")=$P(DFLT,U,2)
  1.  I $L($P($G(^XTV(8989.51,+PAR,SUB+1)),U,3)) S DIR("?")=$P(^(SUB+1),U,3)
  1.  I TYP="S" S DIR("?")="^D SHWINST^XPAREDT2(ENT,PAR,20,1)"
  1.  S DIR("??")="^D SHWDESC^XPAREDT2(PAR)"
  1.  I $E(DIR(0))="W" D
  1.  . S $P(DIR(0),U,1)="FOA",WP=1
  1.  . K ^TMP($J,"XPARWP") M ^TMP($J,"XPARWP")=DFLT
  1.  I $E(DIR(0))="S" S $P(DIR(0),U,1)=$P(DIR(0),U,1)_"M"
  1.  ; PDIR simulates call to DIR, returning X & Y
  1.  D PDIR S DTA("X")=X,DTA=Y S:$D(DTOUT)!$D(DUOUT) DTA=""
  1.  I $D(DTOUT)!$D(DUOUT)!("@"[DTA) Q
  1.  I $E(DIR(0))="P" S DTA="`"_+Y_U_$P(Y(0),U,1)
  1.  I "SDY"[$E(DIR(0)) S DTA=Y_U_$P(Y(0),U,1)
  1.  I '$L($P(DTA,U,2)) S $P(DTA,U,2)=$P(DTA,U)
  1.  I '$D(DIRUT),$G(WP) D  ; edit the word processing field
  1.  . N DIWESUB,DIC,Y
  1.  . S DIWESUB=$P(DTA,U,2),DIC="^TMP($J,""XPARWP"","
  1.  . D EN^DIWE
  1.  . S I=0 F  S I=$O(^TMP($J,"XPARWP",I)) Q:'I  S DTA(I,0)=^(I,0)
  1.  Q
  1. PDIR ; call DIR if not pointer type, otherwise call DIC
  1.  N DIC S X=""
  1.  I $E(DIR(0))'="P" D ^DIR S:X="@" Y="@" Q
  1.  F  D  I $D(DTOUT)!$D(DUOUT)!($L(Y))!('$L(X)) Q
  1.  . S DIC=+$P(DIR(0),U,2),DIC(0)="EMQZ"
  1.  . S:$D(DIR("S")) DIC("S")=DIR("S")
  1.  . W !,DIR("A")_$S($D(DIR("B")):DIR("B")_"// ",1:"")
  1.  . R X:DTIME S:'$T DTOUT="" S:$E(X)=U DUOUT="" S:X="@" Y="@"
  1.  . I '$L(X),$L($G(DFLT)) S X=$P(DFLT,U) ;"`"_+DFLT
  1.  . I X="?",$L($P($G(DIR("?")),U,2)) X $P(DIR("?"),U,2,999)
  1.  . I $D(INSTLST),$L(X),($E(X)'="`") D  ; match existing instance
  1.  . . N I S I=0
  1.  . . F  S I=$O(INSTLST(I)) Q:'I  I $E($P(INSTLST(I),U),1,$L(X))=X D  Q
  1.  . . . W $E($P(INSTLST(I),U),$L(X)+1,999)
  1.  . . . S X=$P(INSTLST(I),U)
  1.  . Q:$D(DTOUT)!$D(DUOUT)!(Y="@")!('$L(X))
  1.  . D ^DIC K DIC("S") I Y<0 S Y=""
  1.  Q
  1. SHWINST(ENT,PAR,CNT,SCR,LST) ; list CNT instances of an entity/parameter
  1.  N I,TERM,ERR,DIR,DIRUT,DUOUT,DTOUT,X,Y,LC,RC,RCPOS
  1.  S TERM=$P($G(^XTV(8989.51,+PAR,0)),U,4) I '$L(TERM) S TERM="Instance"
  1.  D GETLST^XPAR(.LST,ENT,PAR,"E",.ERR) I ERR W $$ERR Q
  1.  I 'LST W !!,"There are currently no entries for ",TERM,".",! Q
  1.  I LST>CNT,'$G(SCR) W !!,LST," entries for ",TERM," currently exist.",! Q
  1.  S LC=$L(TERM),RC=$L("Value")
  1.  S I=0
  1.  F  S I=$O(LST(I)) Q:'I  D
  1.  . I $L($P(LST(I),U,1))>LC S LC=$L($P(LST(I),U,1))
  1.  . I $L($P(LST(I),U,2))>RC S RC=$L($P(LST(I),U,2))
  1.  I LC+RC>77 D
  1.  . I LC>38,RC<38 S LC=77-RC Q
  1.  . I LC<38,RC>38 S RC=77-LC Q
  1.  . S LC=38,RC=39
  1.  S RCPOS=LC+2
  1.  W !!,TERM,?RCPOS,"Value",!,$$DASH^XPAREDIT($L(TERM)),?RCPOS,"-----",!
  1.  S I=0 F  S I=$O(LST(I)) Q:'I  D  Q:$D(DUOUT)
  1.  . W $E($P(LST(I),U,1),1,LC),?RCPOS,$E($P(LST(I),U,2),1,RC),!
  1.  . I I#CNT=0,$O(LST(I)) S DIR(0)="E" D ^DIR W !
  1.  Q
  1. SELINST(INST,ENT,PAR) ; select a specific instance from multiple parameter
  1.  ; .INST=external value of instance
  1.  N TERM,ERR,DIR
  1.  S TERM=$P($G(^XTV(8989.51,+PAR,0)),U,4) S:'$L(TERM) TERM="Instance"
  1.  S INST="" D EDITVAL(.INST,+PAR,"S") Q:'$L(INST)!($E(INST)=U)
  1.  I $P(INST,U)=" " D
  1.  . S INST=$G(^DISV(DUZ,"XPAR01",+PAR,ENT)) S:INST="" INST=" "
  1.  I '$L($$GET^XPAR(ENT,PAR,$P(INST,U))) D  ; if instance does not exist
  1.  . S DIR(0)="Y",DIR("B")="Yes"            ; verify adding new one
  1.  . S DIR("A")="Are you adding "_$P(INST,U,2)_" as a new "_TERM
  1.  . D ^DIR I $D(DIRUT)!('Y) S INST="" Q
  1.  . ; D ADD^XPAR(ENT,+PAR,INST,"",.ERR) I ERR W $$ERR S INST=""
  1.  ; DIR doesn't return space, so spacebar recall only works with Free
  1.  I $L(INST),$E($G(^XTV(8989.51,+PAR,6)))="F" D
  1.  . S ^DISV(DUZ,"XPAR01",+PAR,ENT)=$P(INST,U,2)
  1.  Q
  1. SHWDESC(PAR) ; show description of parameter
  1.  Q:'PAR  S I=0 F  S I=$O(^XTV(8989.51,PAR,20,I)) Q:'I  W !,^(I,0)
  1.  Q
  1. ERR() ; function - displays error message, expects ERR to be present
  1.  W !!,">>>  ",$P($G(ERR),U,2),!!
  1.  Q ""