XPARDD1.m

XPARDD1 ; SLC/KCM - DD Logic for Parameter Definition (8989.51);03:31 PM  22 Apr 1998 ;12/19/07  15:56

 ;;7.3;TOOLKIT;**26,110**;Apr 25, 1995;Build 16

 ;

ALLOW(FN) ; Screens allowable entities to variable ptrs in 8989.5,.01

 ; ** VPDD ** see which files 8989.5 can point to

 Q:'FN 0

 Q $D(^DD(8989.5,.01,"V","B",FN))>0

 ;

VALID01 ; -- Input transform for NAME (8989.51,.01), prevent duplicate names

 ; ( Need to figure out how to check for duplicates and have verify

 ;   fields still work )

 I $L(X)>30!($L(X)<3)!'(X'?1P.E) K X Q  ; Length 3-30

 I X'?1U1UN.E K X Q                     ; Must begin with namespace ;p110

 I $D(^XTV(8989.51,"B",X)) D  Q         ; No duplicates

 . K X D EN^DDIOL("Duplicate parameter names not allowed.")

 Q

AG ; -- AG cross reference, called from 8989.513,.01

 ;

 ; ^XTV(8989.51,PARAMETER,30,"AG",GLOBAL REFERENCE,DA)=""

 ;

 ; GLOBAL REFERENCE is the variable pointer reference to the file

 ; PARAMETER is the internal entry number of the parameter

 ;

AGS ; Set the AG cross-reference for the PARAMETER DEFINITION file

 N GREF

 D FILE^DID(X,"","GLOBAL NAME","GREF")

 S GREF=$P($G(GREF("GLOBAL NAME")),"^",2)

 I $L(GREF) S ^XTV(8989.51,DA(1),30,"AG",GREF,DA)=""

 Q

AGK ; Kill the AG cross-referenece for the PARAMETER DEFINITION file

 N GREF

 D FILE^DID(X,"","GLOBAL NAME","GREF")

 S GREF=$P($G(GREF("GLOBAL NAME")),"^",2)

 I $L(GREF) K ^XTV(8989.51,DA(1),30,"AG",GREF,DA)

 Q

UPPER(X) ; function used by "C" x-ref in .02 field

 Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")

XPARDD1   ; SLC/KCM - DD Logic for Parameter Definition (8989.51);03:31 PM  22 Apr 1998 ;12/19/07  15:56

 +1       ;;7.3;TOOLKIT;**26,110**;Apr 25, 1995;Build 16

 +2       ;

ALLOW(FN) ; Screens allowable entities to variable ptrs in 8989.5,.01

 +1       ; ** VPDD ** see which files 8989.5 can point to

 +2        IF 'FN

               QUIT 0

 +3        QUIT $DATA(^DD(8989.5,.01,"V","B",FN))>0

 +4       ;

VALID01   ; -- Input transform for NAME (8989.51,.01), prevent duplicate names

 +1       ; ( Need to figure out how to check for duplicates and have verify

 +2       ;   fields still work )

 +3       ; Length 3-30

           IF $LENGTH(X)>30!($LENGTH(X)<3)!'(X'?1P.E)

               KILL X

               QUIT 

 +4       ; Must begin with namespace ;p110

           IF X'?1U1UN.E

               KILL X

               QUIT 

 +5       ; No duplicates

           IF $DATA(^XTV(8989.51,"B",X))

               Begin DoDot:1

 +6                KILL X

                   DO EN^DDIOL("Duplicate parameter names not allowed.")

               End DoDot:1

               QUIT 

 +7        QUIT 

AG        ; -- AG cross reference, called from 8989.513,.01

 +1       ;

 +2       ; ^XTV(8989.51,PARAMETER,30,"AG",GLOBAL REFERENCE,DA)=""

 +3       ;

 +4       ; GLOBAL REFERENCE is the variable pointer reference to the file

 +5       ; PARAMETER is the internal entry number of the parameter

 +6       ;

AGS       ; Set the AG cross-reference for the PARAMETER DEFINITION file

 +1        NEW GREF

 +2        DO FILE^DID(X,"","GLOBAL NAME","GREF")

 +3        SET GREF=$PIECE($GET(GREF("GLOBAL NAME")),"^",2)

 +4        IF $LENGTH(GREF)

               SET ^XTV(8989.51,DA(1),30,"AG",GREF,DA)=""

 +5        QUIT 

AGK       ; Kill the AG cross-referenece for the PARAMETER DEFINITION file

 +1        NEW GREF

 +2        DO FILE^DID(X,"","GLOBAL NAME","GREF")

 +3        SET GREF=$PIECE($GET(GREF("GLOBAL NAME")),"^",2)

 +4        IF $LENGTH(GREF)

               KILL ^XTV(8989.51,DA(1),30,"AG",GREF,DA)

 +5        QUIT 

UPPER(X)  ; function used by "C" x-ref in .02 field

 +1        QUIT $TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")