source: FOIAVistA/trunk/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XPAREDT3.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.7 KB
Line 
1XPAREDT3 ;SLC/KCM - Parameter Templates
2 ;;7.3;TOOLKIT;**26**;Apr 25, 1995
3 ;
4SELTED ; select template then edit
5 N DIC,Y
6 S DIC=8989.52,DIC(0)="AEMQ" D ^DIC Q:Y<0
7 D TED^XPAREDIT(+Y,"BA")
8 Q
9TED ; come here from TED^XPAREDIT(TLT,SHWFLG,ALLENT)
10 ; edit templates - suppress display of dashed header for each value
11 N NOHDR S NOHDR=""
12TEDH ; come here from TEDH^XPAREDIT(TLT,SHWFLG,ALLENT)
13 ; Edits parameters using a template
14 ; TLT: name of a template in (or pointer to) PARAMETER TEMPLATE file
15 N ALLINST,ENT,SEQ,IEN,PAR,TLTJMP,DIRUT,DTOUT,DUOUT
16 I 'TLT S TLT=$O(^XTV(8989.52,"B",TLT,0))
17 I 'TLT W !!,$C(7),"Parameter template not found.",! Q
18 I '$L($G(ALLENT)) D SELENT(.ALLENT,TLT) Q:$D(DTOUT)!$D(DUOUT)
19 D SELINST(.ALLINST,ALLENT,TLT) Q:$D(DTOUT)!$D(DUOUT)
20 I $G(SHWFLG)["B" D SHWTLT(ALLENT,ALLINST,TLT)
21 ; set up ref array for ^jumping
22 S (SEQ,CNT)=0 F S SEQ=$O(^XTV(8989.52,TLT,10,"B",SEQ)) Q:'SEQ D
23 . S IEN=0 F S IEN=$O(^XTV(8989.52,TLT,10,"B",SEQ,IEN)) Q:'IEN D
24 . . S PAR=$P(^XTV(8989.52,TLT,10,IEN,0),U,2),X=^XTV(8989.51,PAR,0)
25 . . S CNT=CNT+1,TLTJMP(CNT)=PAR_U_$P(X,U,2)_U_$P(X,U,5)
26 . . I $L($P(X,U,5)) S TLTJMP("B",$$UP^XLFSTR($P(X,U,5)),CNT)="" I 1
27 . . E I $L($P(X,U,2)) S TLTJMP("B",$$UP^XLFSTR($P(X,U,2)),CNT)=""
28 S SEQ=0 F S SEQ=$O(TLTJMP(SEQ)) Q:'SEQ D Q:$D(DTOUT)!$D(DUOUT)
29 . S PAR=$P(TLTJMP(SEQ),U,1,2)
30 . S ENT=ALLENT
31 . I 'ENT D GETENT^XPAREDIT(.ENT,PAR) I 'ENT S DUOUT="" Q
32 . I ENT D TEDIT^XPAREDIT(ENT,PAR,ALLINST,.VAL)
33 . I $E(VAL)=U D
34 . . S X=$$UP^XLFSTR($E(VAL,2,$L(VAL)-1)_$C($A($E(VAL,$L(VAL))-1)))
35 . . S X=$O(TLTJMP("B",X)) I $L(X) S SEQ=$O(TLTJMP("B",X,0))-.1
36 I $G(SHWFLG)["A" D SHWTLT(ALLENT,ALLINST,TLT,1) S DIR(0)="E" D ^DIR
37 Q
38SELENT(ENT,TLT) ; Select an entity for use with the template
39 ; .ENT: Returns the selected entity or null
40 ; TLT: passed in pointer to the parameter template file
41 N FN S FN=$P(^XTV(8989.52,TLT,0),U,3),ENT="" Q:'FN
42 ; begin case FN
43 I FN=9.4 D G XC1 ; get package pointer for this template
44 . N PKG,NAM
45 . S NAM=$P(^XTV(8989.52,TLT,0),U),PKG=NAM
46 . F S PKG=$O(^DIC(9.4,"C",PKG),-1) Q:$E(NAM,1,$L(PKG))=PKG
47 . S PKG=$O(^DIC(9.4,"C",PKG,0))
48 . I PKG S ENT=PKG_";DIC(9.4,"
49 I FN=4.2 D G XC1 ; get domain pointer
50 . I '$D(XPARSYS) S XPARSYS=$$FIND1^DIC(4.2,"","QX",$$KSP^XUPARAM("WHERE"))_";DIC(4.2,"
51 . S ENT=XPARSYS
52 I FN=4 D G:ENT XC1 ; get division pointer
53 . N DIV S DIV=$$KSP^XUPARAM("INST")
54 . I $$GET1^DIQ(4,DIV_",",5,"I")'="Y" S ENT=DIV_";DIC(4,"
55 D LOOKUP^XPAREDIT(.ENT,FN) ; otherwise, lookup entity
56XC1 ; end case FN
57 I 'ENT S DUOUT="" ; no entity selected, treat as "^"
58 Q
59SELINST(INST,ENT,TLT) ; Display instances & select from list, or add new
60 S INST="" N PAR,INSTLST Q:'ENT
61 S PAR=$P(^XTV(8989.52,TLT,0),U,4) Q:'PAR
62 D GETLST^XPAR(.INSTLST,ENT,PAR,"E")
63 ;D SHWINST^XPAREDT2(ENT,PAR,20,0,.INSTLST)
64 D SELINST^XPAREDT2(.INST,ENT,PAR)
65 I INST="" S DUOUT=""
66 Q
67SHWTLT(ENT,INST,TLT,AFT) ; Display all values for a template
68 Q:'ENT
69 N X,SEQ,CNT,IEN,PAR,LST,LF,I
70 S X=$P(^XTV(8989.52,TLT,0),U,2)_$$ENTDISP^XPAREDIT(ENT)
71 I $L(INST) S X=X_", "_$P(INST,U,2)
72 I $G(AFT) S X=X_" is now:"
73 W !!,X,!,$$DASH^XPAREDIT(78),!
74 I $E(INST)="`" S INST=$E(INST,2,999)
75 S (SEQ,CNT)=0 F S SEQ=$O(^XTV(8989.52,TLT,10,"B",SEQ)) Q:'SEQ D
76 . S IEN=0 F S IEN=$O(^XTV(8989.52,TLT,10,"B",SEQ,IEN)) Q:'IEN D
77 . . S PAR=$P(^XTV(8989.52,TLT,10,IEN,0),U,2),X=^XTV(8989.51,PAR,0)
78 . . W $P(X,U,2)
79 . . I $P(X,U,3) D ; multi-valued
80 . . . D GETLST^XPAR(.LST,ENT,PAR,"B") S LF=0
81 . . . S I=0 F S I=$O(LST(I)) Q:'I I (LST(I,"N")=INST)!('$L(INST)) D
82 . . . . W ?29," ",$P(LST(I,"N"),U,2),?49," ",$P(LST(I,"V"),U,2),!
83 . . . . S LF=1
84 . . . I 'LF W !
85 . . E D ; single-valued
86 . . . W ?49," ",$$GET^XPAR(ENT,PAR,1,"E"),!
87 W $$DASH^XPAREDIT(78)
88 Q
Note: See TracBrowser for help on using the repository browser.