Annotation of freem_fileman/DIQGDD.m, revision 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