DIKKDD.m

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

 ;;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.

 ;

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DIKKDD   1100     printed  Apr 09, 2024@21:44:36                                                                                                                                                                                                      Page 2

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

 +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       ;

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