Annotation of freem_fileman/DIQGDD.m, revision 1.1.1.1
1.1 snw 1: DIQGDD ;SFISC/DCL-DATA DICTIONARY ATTRIBUTE RETRIEVER;01:52 PM 12 Sep 1994;
2: ;;21.0;VA FileMan;;Dec 28, 1994
3: ;Per VHA Directive 10-93-142, this routine should not be modified.
4: GET(DIQGR,DA,DR,DIQGPARM,DIQGETA,DIQGERRA,DIQGIPAR) ;
5: EN3 I $G(U)'="^" N U S U="^"
6: I $G(DIQGIPAR)'["A" K DIERR,^TMP("DIERR",$J)
7: I $G(DIQGR)'>0 N X S X(1)="FILE" Q $$F^DIQG(.X,1)
8: I $G(DA)']"" S DA=DIQGR,DIQGR=1 I '$D(^DIC(DA,0)) S X(1)="FILE" Q $$F^DIQG(.X,1)
9: S:DIQGR>1 DIQGPARM=$G(DIQGPARM)_"D"
10: I DA'?.N,$D(^DD(DIQGR,"B",DA)) S DA=$O(^(DA,"")) I $O(^(DA)) D 200 Q ""
11: I DA'>0 D 200 Q ""
12: I '$$VLDATRBT(DIQGR=1,$G(DR)) D 202("ATTRIBUTE") Q ""
13: I DR="FIELD LENGTH" Q $$FL^DIQGDDU(DIQGR,DA)
14: I DR="REQUIRED IDENTIFIERS" G RI^DIQGDDU
15: G DDENTRY^DIQG
16: ;
17: FILE(DIQGR,DR,DIQGPARM,DIQGTA,DIQGERRA,DIQGIPAR) ;
18: EN2 N DA
19: S DA=""
20: I '$G(DIQGR),$G(DIQGR)]"",$D(^DIC("B",DIQGR)) S DIQGR=$O(^(DIQGR,""))
21: G EN1
22: ;
23: FIELD(DIQGR,DA,DR,DIQGPARM,DIQGTA,DIQGERRA,DIQGIPAR) ;
24: EN1 N DIQGERR,DIQGEY,DIQGSAL,DIQGFNUL,DIQGSALX,DIQGTAXX
25: S DIQGEY(1)=$G(DIQGR)
26: I $G(U)'="^" N U S U="^"
27: I $G(DIQGIPAR)'["A" K DIERR,^TMP("DIERR",$J)
28: I $G(DIQGR)'>0 D 202("FILE") Q
29: I '$D(^DD(DIQGR,0)) D 202("FILE") Q
30: I $G(DA)']"" S DA=DIQGR,DIQGR=1 I '$D(^DIC(DA,0)) D 202("FILE") Q
31: I $G(DIQGTA)']"" D 202("TARGET ARRAY") Q
32: S DIQGPARM=$G(DIQGPARM)_$S(DIQGR>1:"D",1:""),DIQGFNUL=DIQGPARM["N"
33: I DA'?.N,$D(^DD(DIQGR,"B",DA)) S DA=$O(^(DA,"")) I $O(^(DA)) N X S X(1)=DA,X("FILE")=DIQGR D BLD^DIALOG(505,.X),FE Q
34: I DA'>0 S DIQGEY(3)=DA D 200 Q
35: I DIQGR>1,'$D(^DD(DIQGR,DA,0)) S DIQGEY(3)=DA D 200 Q
36: D BLDSAL(DIQGR=1,.DR,.DIQGSAL)
37: I '$D(DIQGSAL),'$D(DIERR) D 200 Q
38: I '$D(DIQGSAL) Q
39: S DIQGSAL="" F S DIQGSAL=$O(DIQGSAL(DIQGSAL)) Q:DIQGSAL="" D
40: .I DIQGR=1,DIQGSAL="REQUIRED IDENTIFIERS" D Q
41: ..N X
42: ..S X=$$RIF^DIQGDDU(DA,DIQGSAL,DIQGTA)
43: ..S:X]"" @DIQGTA@(DIQGSAL)=X
44: ..Q
45: .S DIQGTAXX=$S('$D(DIQGSAL(DIQGSAL,"#(word-processing)")):DIQGTA,1:$$OREF(DIQGTA)_$$Q(DIQGSAL)_")")
46: .I DIQGR>1,DIQGSAL="FIELD LENGTH" S DIQGSALX=$$FL^DIQGDDU(DIQGR,DA) G SET
47: .S DIQGSALX=$$GET^DIQG($S(DIQGR>1:"^DD("_DIQGR_",",1:"^DIC("),DA,DIQGSAL(DIQGSAL),DIQGPARM,DIQGTAXX,"","1A")
48: .;I $D(DIQGSAL(DIQGSAL,"#(word-processing)")) Q
49: SET .I DIQGSALX]"" S @DIQGTA@(DIQGSAL)=DIQGSALX Q
50: .Q:DIQGFNUL
51: .S @DIQGTA@(DIQGSAL)=DIQGSALX
52: .Q
53: Q
54: ;
55: BLDSAL(DIQGTYPE,DIQGDR,DIQGVALA) ;DIQGTYPE=1 for FILE and 0 for FIELD, DIQGDR=string/array, DIQGVALA=valid attribute list array
56: ; * If DIQGDR is an array pass by reference *
57: I $G(DIQGDR)="*" D LIST^DIQGDDT($S(DIQGTYPE=1:"FILETXT",1:"FIELDTXT"),.DIQGVALA,"",3) Q
58: N DIQGER,DIQGI,DIQGX,DIQGY D LIST^DIQGDDT($S(DIQGTYPE=1:"FILETXT",1:"FIELDTXT"),.DIQGX,"",3)
59: I $G(DIQGDR)]"" F DIQGI=1:1 S DIQGY=$P(DIQGDR,";",DIQGI) Q:DIQGY="" D
60: .I '$D(DIQGX(DIQGY)) S DIQGER(4)=DIQGY D 200 Q
61: .S DIQGVALA(DIQGY)=DIQGX(DIQGY) S:$D(DIQGX(DIQGY,"#(word-processing)")) DIQGVALA(DIQGY,"#(word-processing)")=DIQGX(DIQGY)
62: Q:$D(DIQGVALA)
63: S DIQGY="" F S DIQGY=$O(DIQGDR(DIQGY)) Q:DIQGY="" D
64: .I '$D(DIQGX(DIQGY)) S DIQGER(4)=DIQGY D 200 Q
65: .S DIQGVALA(DIQGY)=DIQGX(DIQGY) S:$D(DIQGX(DIQGY,"#(word-processing)")) DIQGVALA(DIQGY,"#(word-processing)")=DIQGX(DIQGY)
66: .Q
67: Q
68: ;
69: XDR(DIQGR,DR,DIQGERR) ;DIQGR DD FILE NUMBER EITHER 1 OR 0
70: ;DR IS DR STRING TO CONVERT TO NUMERIC DR STRING
71: S DIQGR=+$G(DIQGR),DR=$G(DR)
72: N I,X,XDR D LIST^DIQGDDT($S(DIQGR=1:"FILETXT",1:"FIELDTXT"),.X,4,3)
73: I $G(DR)]"" S (X,XDR)="" F I=1:1 S X=$P(DR,";",I) Q:X="" D
74: .I '$D(X(X)) S DIQGERR(X)="" Q
75: .S XDR=XDR_X(X)_";" Q
76: I $D(DR)>1 S (X,XDR)="" F S X=$O(DR(X)) Q:X="" D:'$D(X(X)) S:X]"" XDR=XDR_X(X)_";"
77: .I '$D(X(X)) S DIQGERR(X)="" Q
78: .S XDR=XDR_X(X)_";" Q
79: Q XDR
80: ;
81: VLDATRBT(TYPE,ATRIB) ;EXTRINSIC FUNCTION $$TEST IF VALID ATTRIBUTE
82: ;TYPE 0 OR 1 - FIELD=0, FILE=1 (^DD(0) OR ^DD(1))
83: ;ATRIB=ATTRIBUTE BEING REQUESTED
84: Q:ATRIB']"" 0
85: N X D LIST^DIQGDDT($S(TYPE=1:"FILETXT",1:"FIELDTXT"),.X)
86: Q $D(X(ATRIB))#2
87: DR(TYPE) ;TYPE=1,FILE OR 0,FIELD AND RETURNS DR STRING FOR ALL ATTRIBUTES IN INTERNAL FORM (ATTRIBUTE FIELD NUMBERS 3RD ;-PIECE
88: S TYPE=+$G(TYPE)
89: N X,Y
90: D LIST^DIQGDDT($S(TYPE=1:"FILETXT",1:"FIELDTXT"),.X,3)
91: S (X,Y)=.01 F S Y=$O(X(Y)) Q:Y'>0 S X=X_";"_Y
92: Q X
93: ;
94: FILELST(DIDARRAY) ;PASS TARGET ARRAY BY REFERENCE * * LIST FILE ATTRIBUTES * *
95: EN4 N EQL,TP,TYPE,DIQGDFLG
96: S TYPE="FILETXT",DIQGDFLG="L"
97: G ENLST^DIQGDDT
98: ;
99: FIELDLST(DIDARRAY) ;PASS TARGET ARRAY BY REFERENCE * * LIST FIELD ATTRIBUTES * *
100: EN5 N EQL,TP,TYPE,DIQGDFLG
101: S TYPE="FIELDTXT",DIQGDFLG="L"
102: G ENLST^DIQGDDT
103: ;
104: OREF(X) N X1,X2 S X1=$P(X,"(")_"(",X2=$$OR2($P(X,"(",2)) Q:X2="" X1 Q X1_X2_","
105: OR2(%) Q:%=")"!(%=",") "" Q:$L(%)=1 % S:"),"[$E(%,$L(%)) %=$E(%,1,$L(%)-1) Q %
106: Q(%Z) S %Z(%Z)="",%Z=$Q(%Z("")) Q $E(%Z,4,$L(%Z)-1)
107: 200 D BLD^DIALOG(200),FE Q
108: 202(E) N X S X(1)=E
109: D BLD^DIALOG(202,.X),FE
110: Q
111: FE I $G(DIQGERRA)]"" D CALLOUT^DIEFU(DIQGERRA)
112: Q
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to DIQGDD.m CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Coherent Logic Development] / freem_fileman