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

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

initial load of FOIAVistA 6/30/08 version
File size: 5.0 KB
Line 
1XPAREDT2 ; SLC/KCM - Supporting Calls - Instances, Values ;04/08/2003 11:22
2 ;;7.3;TOOLKIT;**26,35,52,74**;Apr 25, 1995
3 ;
4EDIT1 ; called only from EDIT, expects ENT,PAR,INST to be defined
5 N VALTYPE,X S VALTYPE=$E($G(^XTV(8989.51,+PAR,1)))
6 I VALTYPE="W" D I ERR W $$ERR Q
7 . D GETWP^XPAR(.X,ENT,+PAR,$P(INST,U),.ERR) S:'ERR $P(X,U,2)=$G(X)
8 I VALTYPE'="W" D
9 . S X=$$GET^XPAR(ENT,+PAR,$P(INST,U),"B")
10 . I $L(X),$E(^XTV(8989.51,+PAR,1))="P" S X="`"_X
11 S Y="" D EDITVAL(.Y,+PAR,"V",.X) Q:(Y="")!($E(Y)=U)
12 I Y="@" D DEL^XPAR(ENT,+PAR,$P(INST,U),.ERR) D Q
13 . I ERR W $$ERR Q
14 . W " ...deleted"
15 ; I VALTYPE'="W" W " ",$P(Y,U,2)
16 S Y=$P(Y,U)
17 D EN^XPAR(ENT,+PAR,$P(INST,U),.Y,.ERR) I ERR W $$ERR Q
18 Q
19EDITVAL(DTA,PAR,TYP,DFLT) ; edit the value for an instance or a value
20 ; .DTA=internal value^external value returned, wp in DTA(n,0) nodes
21 ; PAR=parameter which describes the data being edited
22 ; TYP=edit type - I:instance, V:value, S:select instance
23 ; .DFLT=internal default value^external default value
24 ; internal values are preceded by "`" if they are pointers
25 N DIR,SUB,TERM,WP,X
26 S SUB=$S(TYP="V":0,1:5),Y=""
27 S DIR(0)=$P($G(^XTV(8989.51,+PAR,SUB+1)),U,1,2)
28 S $P(DIR(0),U,1)=$P(DIR(0),U,1)_"OA"
29 I "P"=$E(DIR(0)) S $P(DIR(0),":",2)="AEMQZ"
30 I $L($G(^XTV(8989.51,+PAR,SUB+2))) S $P(DIR(0),U,3)=^(SUB+2)
31 I $L($G(^XTV(8989.51,+PAR,SUB+3))) S DIR("S")=^(SUB+3)
32 I (TYP="I")!(TYP="S") S TERM=$P($G(^XTV(8989.51,+PAR,0)),U,4)
33 I TYP="V" S TERM=$P($G(^XTV(8989.51,+PAR,0)),U,5)
34 I '$L(TERM) S TERM=$S(TYP="V":"Value",1:"Instance")
35 S DIR("A")=$S(TYP="S":"Select ",1:"")_TERM_": "
36 I $L($G(DFLT)) S DIR("B")=$P(DFLT,U,2)
37 I $L($P($G(^XTV(8989.51,+PAR,SUB+1)),U,3)) S DIR("?")=$P(^(SUB+1),U,3)
38 I TYP="S" S DIR("?")="^D SHWINST^XPAREDT2(ENT,PAR,20,1)"
39 S DIR("??")="^D SHWDESC^XPAREDT2(PAR)"
40 I $E(DIR(0))="W" D
41 . S $P(DIR(0),U,1)="FOA",WP=1
42 . K ^TMP($J,"XPARWP") M ^TMP($J,"XPARWP")=DFLT
43 I $E(DIR(0))="S" S $P(DIR(0),U,1)=$P(DIR(0),U,1)_"M"
44 ; PDIR simulates call to DIR, returning X & Y
45 D PDIR S DTA("X")=X,DTA=Y S:$D(DTOUT)!$D(DUOUT) DTA=""
46 I $D(DTOUT)!$D(DUOUT)!("@"[DTA) Q
47 I $E(DIR(0))="P" S DTA="`"_+Y_U_$P(Y(0),U,1)
48 I "SDY"[$E(DIR(0)) S DTA=Y_U_$P(Y(0),U,1)
49 I '$L($P(DTA,U,2)) S $P(DTA,U,2)=$P(DTA,U)
50 I '$D(DIRUT),$G(WP) D ; edit the word processing field
51 . N DIWESUB,DIC,Y
52 . S DIWESUB=$P(DTA,U,2),DIC="^TMP($J,""XPARWP"","
53 . D EN^DIWE
54 . S I=0 F S I=$O(^TMP($J,"XPARWP",I)) Q:'I S DTA(I,0)=^(I,0)
55 Q
56PDIR ; call DIR if not pointer type, otherwise call DIC
57 N DIC S X=""
58 I $E(DIR(0))'="P" D ^DIR S:X="@" Y="@" Q
59 F D I $D(DTOUT)!$D(DUOUT)!($L(Y))!('$L(X)) Q
60 . S DIC=+$P(DIR(0),U,2),DIC(0)="EMQZ"
61 . S:$D(DIR("S")) DIC("S")=DIR("S")
62 . W !,DIR("A")_$S($D(DIR("B")):DIR("B")_"// ",1:"")
63 . R X:DTIME S:'$T DTOUT="" S:$E(X)=U DUOUT="" S:X="@" Y="@"
64 . I '$L(X),$L($G(DFLT)) S X=$P(DFLT,U) ;"`"_+DFLT
65 . I X="?",$L($P($G(DIR("?")),U,2)) X $P(DIR("?"),U,2,999)
66 . I $D(INSTLST),$L(X),($E(X)'="`") D ; match existing instance
67 . . N I S I=0
68 . . F S I=$O(INSTLST(I)) Q:'I I $E($P(INSTLST(I),U),1,$L(X))=X D Q
69 . . . W $E($P(INSTLST(I),U),$L(X)+1,999)
70 . . . S X=$P(INSTLST(I),U)
71 . Q:$D(DTOUT)!$D(DUOUT)!(Y="@")!('$L(X))
72 . D ^DIC K DIC("S") I Y<0 S Y=""
73 Q
74SHWINST(ENT,PAR,CNT,SCR,LST) ; list CNT instances of an entity/parameter
75 N I,TERM,ERR,DIR,DIRUT,DUOUT,DTOUT,X,Y,LC,RC,RCPOS
76 S TERM=$P($G(^XTV(8989.51,+PAR,0)),U,4) I '$L(TERM) S TERM="Instance"
77 D GETLST^XPAR(.LST,ENT,PAR,"E",.ERR) I ERR W $$ERR Q
78 I 'LST W !!,"There are currently no entries for ",TERM,".",! Q
79 I LST>CNT,'$G(SCR) W !!,LST," entries for ",TERM," currently exist.",! Q
80 S LC=$L(TERM),RC=$L("Value")
81 S I=0
82 F S I=$O(LST(I)) Q:'I D
83 . I $L($P(LST(I),U,1))>LC S LC=$L($P(LST(I),U,1))
84 . I $L($P(LST(I),U,2))>RC S RC=$L($P(LST(I),U,2))
85 I LC+RC>77 D
86 . I LC>38,RC<38 S LC=77-RC Q
87 . I LC<38,RC>38 S RC=77-LC Q
88 . S LC=38,RC=39
89 S RCPOS=LC+2
90 W !!,TERM,?RCPOS,"Value",!,$$DASH^XPAREDIT($L(TERM)),?RCPOS,"-----",!
91 S I=0 F S I=$O(LST(I)) Q:'I D Q:$D(DUOUT)
92 . W $E($P(LST(I),U,1),1,LC),?RCPOS,$E($P(LST(I),U,2),1,RC),!
93 . I I#CNT=0,$O(LST(I)) S DIR(0)="E" D ^DIR W !
94 Q
95SELINST(INST,ENT,PAR) ; select a specific instance from multiple parameter
96 ; .INST=external value of instance
97 N TERM,ERR,DIR
98 S TERM=$P($G(^XTV(8989.51,+PAR,0)),U,4) S:'$L(TERM) TERM="Instance"
99 S INST="" D EDITVAL(.INST,+PAR,"S") Q:'$L(INST)!($E(INST)=U)
100 I $P(INST,U)=" " D
101 . S INST=$G(^DISV(DUZ,"XPAR01",+PAR,ENT)) S:INST="" INST=" "
102 I '$L($$GET^XPAR(ENT,PAR,$P(INST,U))) D ; if instance does not exist
103 . S DIR(0)="Y",DIR("B")="Yes" ; verify adding new one
104 . S DIR("A")="Are you adding "_$P(INST,U,2)_" as a new "_TERM
105 . D ^DIR I $D(DIRUT)!('Y) S INST="" Q
106 . ; D ADD^XPAR(ENT,+PAR,INST,"",.ERR) I ERR W $$ERR S INST=""
107 ; DIR doesn't return space, so spacebar recall only works with Free
108 I $L(INST),$E($G(^XTV(8989.51,+PAR,6)))="F" D
109 . S ^DISV(DUZ,"XPAR01",+PAR,ENT)=$P(INST,U,2)
110 Q
111SHWDESC(PAR) ; show description of parameter
112 Q:'PAR S I=0 F S I=$O(^XTV(8989.51,PAR,20,I)) Q:'I W !,^(I,0)
113 Q
114ERR() ; function - displays error message, expects ERR to be present
115 W !!,">>> ",$P($G(ERR),U,2),!!
116 Q ""
Note: See TracBrowser for help on using the repository browser.