- DDSCAP ;SFISC/MKO-INPUT TRANSFORM FOR CAPTIONS ;10:45 AM 6 Mar 1996
- ;;22.0;VA FileMan;;Mar 30, 1999
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- FUNC(X) ;
- Q:$E(X)'="!"
- N E,F,Y
- S F=$E(X,2,999)
- S:$P(F,"(")?.A1.L.A F=$$UPCASE($P(F,"("))_$S(F["(":"("_$P(F,"(",2,999),1:"")
- Q:$P(F,"(")'?1U.7UN X
- Q:$T(@$P(F,"("))="" X
- ;
- D Q:$G(E) X
- . N X S X="S Y=$$"_F
- . N F D ^DIM
- . S:'$D(X) E=1
- ;
- S @("Y=$$"_F)
- Q Y
- ;
- L() ;;Get label of field
- N F1,F2
- S X=""
- S F1=$$GET^DDSVAL(DIE,.DA,4) Q:'F1 X
- S F2=$$GET^DDSVAL(.404,DA(1),1) Q:'F2 X
- S X=$P($G(^DD(F2,F1,0)),U)
- Q X
- ;
- T() ;;Get title of field
- N F1,F2
- S X=""
- S F1=$$GET^DDSVAL(DIE,.DA,4) Q:'F1 X
- S F2=$$GET^DDSVAL(.404,DA(1),1) Q:'F2 X
- S X=$G(^DD(F2,F1,.1))
- Q X
- ;
- U() ;;Get unique name of field
- Q $$GET^DDSVAL(DIE,.DA,3.1)
- ;
- DUP(X1,X) ;;The DUP function
- Q:$G(X1)="" ""
- N %
- S %=X,X="",$P(X,X1,%\$L(X1)+1)=X1,X=$E(X,1,%)
- Q X
- ;
- UPCASE(X) ;Convert X to uppercase
- Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
- DDSCAP ;SFISC/MKO-INPUT TRANSFORM FOR CAPTIONS ;10:45 AM 6 Mar 1996
- +1 ;;22.0;VA FileMan;;Mar 30, 1999
- +2 ;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- FUNC(X) ;
- +1 IF $EXTRACT(X)'="!"
- QUIT
- +2 NEW E,F,Y
- +3 SET F=$EXTRACT(X,2,999)
- +4 IF $PIECE(F,"(")?.A1.L.A
- SET F=$$UPCASE($PIECE(F,"("))_$SELECT(F["(":"("_$PIECE(F,"(",2,999),1:"")
- +5 IF $PIECE(F,"(")'?1U.7UN
- QUIT X
- +6 IF $TEXT(@$PIECE(F,"("))=""
- QUIT X
- +7 ;
- +8 Begin DoDot:1
- +9 NEW X
- SET X="S Y=$$"_F
- +10 NEW F
- DO ^DIM
- +11 IF '$DATA(X)
- SET E=1
- End DoDot:1
- IF $GET(E)
- QUIT X
- +12 ;
- +13 SET @("Y=$$"_F)
- +14 QUIT Y
- +15 ;
- L() ;;Get label of field
- +1 NEW F1,F2
- +2 SET X=""
- +3 SET F1=$$GET^DDSVAL(DIE,.DA,4)
- IF 'F1
- QUIT X
- +4 SET F2=$$GET^DDSVAL(.404,DA(1),1)
- IF 'F2
- QUIT X
- +5 SET X=$PIECE($GET(^DD(F2,F1,0)),U)
- +6 QUIT X
- +7 ;
- T() ;;Get title of field
- +1 NEW F1,F2
- +2 SET X=""
- +3 SET F1=$$GET^DDSVAL(DIE,.DA,4)
- IF 'F1
- QUIT X
- +4 SET F2=$$GET^DDSVAL(.404,DA(1),1)
- IF 'F2
- QUIT X
- +5 SET X=$GET(^DD(F2,F1,.1))
- +6 QUIT X
- +7 ;
- U() ;;Get unique name of field
- +1 QUIT $$GET^DDSVAL(DIE,.DA,3.1)
- +2 ;
- DUP(X1,X) ;;The DUP function
- +1 IF $GET(X1)=""
- QUIT ""
- +2 NEW %
- +3 SET %=X
- SET X=""
- SET $PIECE(X,X1,%\$LENGTH(X1)+1)=X1
- SET X=$EXTRACT(X,1,%)
- +4 QUIT X
- +5 ;
- UPCASE(X) ;Convert X to uppercase
- +1 QUIT $TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")