DDSCAP.m

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")