- DDSCAP ;SFISC/MKO-INPUT TRANSFORM FOR CAPTIONS ;01:24 PM 14 Aug 2002
- ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
- ;;Per VA Directive 6402, this routine should not be modified.
- ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
- ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
- ;;Licensed under the terms of the Apache License, Version 2.0.
- ;
- 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 $$UP^DILIBF(X) ;**
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDSCAP 1227 printed Mar 13, 2025@21:47:56 Page 2
- DDSCAP ;SFISC/MKO-INPUT TRANSFORM FOR CAPTIONS ;01:24 PM 14 Aug 2002
- +1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
- +4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
- +5 ;;Licensed under the terms of the Apache License, Version 2.0.
- +6 ;
- 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 $$UP^DILIBF(X)
