[BACK]Return to DIQGDD.m CVS log [TXT] [DIR] Up to [Coherent Logic Development] / freem_fileman / USER
File:  [Coherent Logic Development] / freem_fileman / USER / DIQGDD.m
Revision 1.1: download - view: text, annotated - select for diffs
Mon Apr 28 14:13:21 2025 UTC (3 months ago) by snw
Branches: MAIN
CVS tags: HEAD
Restructure repository

    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>