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

    1: DDSCAP	;SFISC/MKO-INPUT TRANSFORM FOR CAPTIONS ;09:00 AM  21 Sep 1993
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: 	;
    5: FUNC(X)	;
    6: 	Q:$E(X)'="!"
    7: 	N F,Y
    8: 	S F=$E(X,2,999)
    9: 	S:$P(F,"(")?.A1.L.A F=$$UPCASE($P(F,"("))_$S(F["(":"("_$P(F,"(",2,999),1:"")
   10: 	Q:$T(@$P(F,"("))="" X
   11: 	S @("Y=$$"_F)
   12: 	Q Y
   13: 	;
   14: L()	;;Get label of field
   15: 	N F1,F2
   16: 	S X=""
   17: 	S F1=$$GET^DDSVAL(DIE,.DA,4) Q:'F1 X
   18: 	S F2=$$GET^DDSVAL(.404,DA(1),1) Q:'F2 X
   19: 	S X=$P($G(^DD(F2,F1,0)),U)
   20: 	Q X
   21: 	;
   22: T()	;;Get title of field
   23: 	N F1,F2
   24: 	S X=""
   25: 	S F1=$$GET^DDSVAL(DIE,.DA,4) Q:'F1 X
   26: 	S F2=$$GET^DDSVAL(.404,DA(1),1) Q:'F2 X
   27: 	S X=$G(^DD(F2,F1,.1))
   28: 	Q X
   29: 	;
   30: U()	;;Get unique name of field
   31: 	Q $$GET^DDSVAL(DIE,.DA,3.1)
   32: 	;
   33: DUP(X1,X)	;;The DUP function
   34: 	Q:$G(X1)="" ""
   35: 	N %
   36: 	S %=X,X="",$P(X,X1,%\$L(X1)+1)=X1,X=$E(X,1,%)
   37: 	Q X
   38: 	;
   39: UPCASE(X)	;Convert X to uppercase
   40: 	Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>