DIKKDD.m

DIKKDD ;SFISC/MKO-DATA DICTIONARY CODE FOR KEY FILE ;1:49 PM  8 Sep 1997

 ;;22.0;VA FileMan;;Mar 30, 1999

 ;Per VHA Directive 10-93-142, this routine should not be modified.

ITFLD ;Input transform for field

 Q:'$D(DA)  Q:'$D(DA(1))

 N DIKKFILE

 S DIKKFILE=$$GETFILE(.DA) I 'DIKKFILE K X Q

 ;

 N %,D,D0,DA,DDD,DIC,DICR,DIX,DO,DP,DZ,Y

 S DIC="^DD("_DIKKFILE_",",DIC(0)="EN",DIC("S")="I '$P(^(0),U,2)"

 D ^DIC

 I Y'>0 K X

 E  S X=+$P(Y,"E")

 Q

 ;

EHFLD ;Executable help for field

 Q:'$D(DA)  Q:'$D(DA(1))

 N DIKKFILE

 S DIKKFILE=$$GETFILE(.DA) Q:'DIKKFILE

 ;

 N %,D,D0,DA,DDD,DIC,DICR,DIX,DO,DP,Y

 S DIC="^DD("_DIKKFILE_",",DIC(0)="",D="B"

 S DIC("S")="I '$P(^(0),U,2)"

 S:$G(X)="??" DZ=X

 D DQ^DICQ

 Q

 ;

GETFILE(DA) ;

 Q:'$D(DA)  Q:'$D(DA(1))

 N DIKKFILE

 I $D(DDS) S DIKKFILE=$$GET^DDSVAL(.31,DA(1),.01)

 E  S DIKKFILE=$P($G(^DD("KEY",DA(1),0)),U)

 Q DIKKFILE

DIKKDD    ;SFISC/MKO-DATA DICTIONARY CODE FOR KEY FILE ;1:49 PM  8 Sep 1997

 +1       ;;22.0;VA FileMan;;Mar 30, 1999

 +2       ;Per VHA Directive 10-93-142, this routine should not be modified.

ITFLD     ;Input transform for field

 +1        IF '$DATA(DA)

               QUIT 

           IF '$DATA(DA(1))

               QUIT 

 +2        NEW DIKKFILE

 +3        SET DIKKFILE=$$GETFILE(.DA)

           IF 'DIKKFILE

               KILL X

               QUIT 

 +4       ;

 +5        NEW %,D,D0,DA,DDD,DIC,DICR,DIX,DO,DP,DZ,Y

 +6        SET DIC="^DD("_DIKKFILE_","

           SET DIC(0)="EN"

           SET DIC("S")="I '$P(^(0),U,2)"

 +7        DO ^DIC

 +8        IF Y'>0

               KILL X

 +9       IF '$TEST

               SET X=+$PIECE(Y,"E")

 +10       QUIT 

 +11      ;

EHFLD     ;Executable help for field

 +1        IF '$DATA(DA)

               QUIT 

           IF '$DATA(DA(1))

               QUIT 

 +2        NEW DIKKFILE

 +3        SET DIKKFILE=$$GETFILE(.DA)

           IF 'DIKKFILE

               QUIT 

 +4       ;

 +5        NEW %,D,D0,DA,DDD,DIC,DICR,DIX,DO,DP,Y

 +6        SET DIC="^DD("_DIKKFILE_","

           SET DIC(0)=""

           SET D="B"

 +7        SET DIC("S")="I '$P(^(0),U,2)"

 +8        IF $GET(X)="??"

               SET DZ=X

 +9        DO DQ^DICQ

 +10       QUIT 

 +11      ;

GETFILE(DA) ;

 +1        IF '$DATA(DA)

               QUIT 

           IF '$DATA(DA(1))

               QUIT 

 +2        NEW DIKKFILE

 +3        IF $DATA(DDS)

               SET DIKKFILE=$$GET^DDSVAL(.31,DA(1),.01)

 +4       IF '$TEST

               SET DIKKFILE=$PIECE($GET(^DD("KEY",DA(1),0)),U)

 +5        QUIT DIKKFILE