| 1 | DDSCAP ;SFISC/MKO-INPUT TRANSFORM FOR CAPTIONS ;10:45 AM  6 Mar 1996
 | 
|---|
| 2 |  ;;22.0;VA FileMan;;Mar 30, 1999
 | 
|---|
| 3 |  ;Per VHA Directive 10-93-142, this routine should not be modified.
 | 
|---|
| 4 |  ;
 | 
|---|
| 5 | FUNC(X) ;
 | 
|---|
| 6 |  Q:$E(X)'="!"
 | 
|---|
| 7 |  N E,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:$P(F,"(")'?1U.7UN X
 | 
|---|
| 11 |  Q:$T(@$P(F,"("))="" X
 | 
|---|
| 12 |  ;
 | 
|---|
| 13 |  D  Q:$G(E) X
 | 
|---|
| 14 |  . N X S X="S Y=$$"_F
 | 
|---|
| 15 |  . N F D ^DIM
 | 
|---|
| 16 |  . S:'$D(X) E=1
 | 
|---|
| 17 |  ;
 | 
|---|
| 18 |  S @("Y=$$"_F)
 | 
|---|
| 19 |  Q Y
 | 
|---|
| 20 |  ;
 | 
|---|
| 21 | L() ;;Get label of field
 | 
|---|
| 22 |  N F1,F2
 | 
|---|
| 23 |  S X=""
 | 
|---|
| 24 |  S F1=$$GET^DDSVAL(DIE,.DA,4) Q:'F1 X
 | 
|---|
| 25 |  S F2=$$GET^DDSVAL(.404,DA(1),1) Q:'F2 X
 | 
|---|
| 26 |  S X=$P($G(^DD(F2,F1,0)),U)
 | 
|---|
| 27 |  Q X
 | 
|---|
| 28 |  ;
 | 
|---|
| 29 | T() ;;Get title of field
 | 
|---|
| 30 |  N F1,F2
 | 
|---|
| 31 |  S X=""
 | 
|---|
| 32 |  S F1=$$GET^DDSVAL(DIE,.DA,4) Q:'F1 X
 | 
|---|
| 33 |  S F2=$$GET^DDSVAL(.404,DA(1),1) Q:'F2 X
 | 
|---|
| 34 |  S X=$G(^DD(F2,F1,.1))
 | 
|---|
| 35 |  Q X
 | 
|---|
| 36 |  ;
 | 
|---|
| 37 | U() ;;Get unique name of field
 | 
|---|
| 38 |  Q $$GET^DDSVAL(DIE,.DA,3.1)
 | 
|---|
| 39 |  ;
 | 
|---|
| 40 | DUP(X1,X) ;;The DUP function
 | 
|---|
| 41 |  Q:$G(X1)="" ""
 | 
|---|
| 42 |  N %
 | 
|---|
| 43 |  S %=X,X="",$P(X,X1,%\$L(X1)+1)=X1,X=$E(X,1,%)
 | 
|---|
| 44 |  Q X
 | 
|---|
| 45 |  ;
 | 
|---|
| 46 | UPCASE(X) ;Convert X to uppercase
 | 
|---|
| 47 |  Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
 | 
|---|