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 11
;
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")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXPARDD1 1563 printed Oct 16, 2024@18:40:53 Page 2
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 11
+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")
