DIKKFORM ;SFISC/MKO-ENTRY POINTS FOR THE 'DIKC EDIT' FORM ;11:34 AM 16 Nov 1998
;;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.
;
;==========================
; [DIKK EDIT] entry points
;==========================
;
PRIOVAL ;Validation on Priority (#1)
Q:$P(^DD("KEY",DA,0),U,3)=X
N PK
I X="P" D
. S PK=$O(^DD("KEY","AP",$$GET^DDSVAL(.31,DA,.01),"P",0)) Q:'PK
. S DDSERROR=1
. D HLP^DDSUTL($C(7)_"Primary Key '"_$P(^DD("KEY",PK,0),U,2)_"' is already defined on this file.")
Q
;
UIVAL ;Validation on Uniqueness Index (#3)
;Index must be Regular, used for Lookup/Sorting, have no set/kill
;conditions, and consist only of field-type cross reference values
;with no transforms.
Q:X=""
N CRV,FIL,FLD,LN0,SS
;
;Check that Index is regular and has no set/kill condition
I $P($G(^DD("IX",X,0)),U,4)'="R" D UIERR("Selected index is not a Regular index.") Q
I $P($G(^DD("IX",X,0)),U,14)'="LS"!($E($P($G(^(0)),U,2))="A") D UIERR("Selected index is not used for Lookup.") Q
D:$G(^DD("IX",X,1.4))'?."^" UIERR("Selected index has a Set Condition.")
D:$G(^DD("IX",X,2.4))'?."^" UIERR("Selected index has a Kill Condition.")
;
;Check Cross Reference Values
S CRV=0 F S CRV=$O(^DD("IX",X,11.1,CRV)) Q:'CRV D
. S LN0=$G(^DD("IX",X,11.1,CRV,0))
. I $P(LN0,U,2)'="F" D UIERR("Selected index has a computed value.") Q
. I $G(^DD("IX",X,11.1,CRV,2))'?."^" D UIERR("Selected index has a value with a transform.") Q
Q
;
UIERR(MSG) ;Set DDSERROR=1 and print MSG
N X
S DDSERROR=1
D HLP^DDSUTL($C(7)_$G(MSG))
Q
;
FORMDV ;Form-Level Data Validation
;In the Fields multiple, check that Sequence Numbers are unique and
;consecutive from 1.
;(Duplicate file/field combinations are checked automatically
;because they're key fields.)
N DIKKDA,DIKKI,DIKKLIST,DIKKSQ
;
;Build list
; DIKKLIST(seq#,ien)
;while checking for duplicates
;
S DIKKDA(1)=DA
S DIKKDA=0 F S DIKKDA=$O(^DD("KEY",DA,2,DIKKDA)) Q:'DIKKDA D
. S DIKKSQ=$$GET^DDSVAL(.312,.DIKKDA,1)
. I $D(DIKKLIST(DIKKSQ)) D
.. D:'$D(DDSERROR) MSG^DDSUTL($C(7)_"UNABLE TO SAVE CHANGES")
.. S DDSERROR=1
.. D MSG^DDSUTL("The sequence number "_DIKKSQ_" is used more than once.")
. E S DIKKLIST(DIKKSQ,DIKKDA)=""
;
;If no duplicates, check that sequence numbers are consecutive from 1
I '$D(DDSERROR) D
. S DIKKSQ=0
. F DIKKI=1:1 S DIKKSQ=$O(DIKKLIST(DIKKSQ)) Q:'DIKKSQ!$G(DDSERROR) D:DIKKSQ'=DIKKI
.. S DDSERROR=1
.. D MSG^DDSUTL($C(7)_"UNABLE TO SAVE CHANGES")
.. D MSG^DDSUTL("Sequence numbers must be consecutive numbers starting with 1.")
Q
;
NAMEPAC ;Post-Action on Change for Name of Key
N DIKKSD,DIKKUI
;
S DIKKUI=$$GET^DDSVAL(.31,DA,3) Q:'DIKKUI
S DIKKSD=$$GET^DDSVAL(.11,DIKKUI,.11)
Q:DIKKSD'?1"Uniqueness Index for Key '"1A1"'".E
;
S $E(DIKKSD,27)=X
D PUT^DDSVAL(.11,DIKKUI,.11,DIKKSD)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIKKFORM 3135 printed Dec 13, 2024@02:49:03 Page 2
DIKKFORM ;SFISC/MKO-ENTRY POINTS FOR THE 'DIKC EDIT' FORM ;11:34 AM 16 Nov 1998
+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 ;
+7 ;==========================
+8 ; [DIKK EDIT] entry points
+9 ;==========================
+10 ;
PRIOVAL ;Validation on Priority (#1)
+1 if $PIECE(^DD("KEY",DA,0),U,3)=X
QUIT
+2 NEW PK
+3 IF X="P"
Begin DoDot:1
+4 SET PK=$ORDER(^DD("KEY","AP",$$GET^DDSVAL(.31,DA,.01),"P",0))
if 'PK
QUIT
+5 SET DDSERROR=1
+6 DO HLP^DDSUTL($CHAR(7)_"Primary Key '"_$PIECE(^DD("KEY",PK,0),U,2)_"' is already defined on this file.")
End DoDot:1
+7 QUIT
+8 ;
UIVAL ;Validation on Uniqueness Index (#3)
+1 ;Index must be Regular, used for Lookup/Sorting, have no set/kill
+2 ;conditions, and consist only of field-type cross reference values
+3 ;with no transforms.
+4 if X=""
QUIT
+5 NEW CRV,FIL,FLD,LN0,SS
+6 ;
+7 ;Check that Index is regular and has no set/kill condition
+8 IF $PIECE($GET(^DD("IX",X,0)),U,4)'="R"
DO UIERR("Selected index is not a Regular index.")
QUIT
+9 IF $PIECE($GET(^DD("IX",X,0)),U,14)'="LS"!($EXTRACT($PIECE($GET(^(0)),U,2))="A")
DO UIERR("Selected index is not used for Lookup.")
QUIT
+10 if $GET(^DD("IX",X,1.4))'?."^"
DO UIERR("Selected index has a Set Condition.")
+11 if $GET(^DD("IX",X,2.4))'?."^"
DO UIERR("Selected index has a Kill Condition.")
+12 ;
+13 ;Check Cross Reference Values
+14 SET CRV=0
FOR
SET CRV=$ORDER(^DD("IX",X,11.1,CRV))
if 'CRV
QUIT
Begin DoDot:1
+15 SET LN0=$GET(^DD("IX",X,11.1,CRV,0))
+16 IF $PIECE(LN0,U,2)'="F"
DO UIERR("Selected index has a computed value.")
QUIT
+17 IF $GET(^DD("IX",X,11.1,CRV,2))'?."^"
DO UIERR("Selected index has a value with a transform.")
QUIT
End DoDot:1
+18 QUIT
+19 ;
UIERR(MSG) ;Set DDSERROR=1 and print MSG
+1 NEW X
+2 SET DDSERROR=1
+3 DO HLP^DDSUTL($CHAR(7)_$GET(MSG))
+4 QUIT
+5 ;
FORMDV ;Form-Level Data Validation
+1 ;In the Fields multiple, check that Sequence Numbers are unique and
+2 ;consecutive from 1.
+3 ;(Duplicate file/field combinations are checked automatically
+4 ;because they're key fields.)
+5 NEW DIKKDA,DIKKI,DIKKLIST,DIKKSQ
+6 ;
+7 ;Build list
+8 ; DIKKLIST(seq#,ien)
+9 ;while checking for duplicates
+10 ;
+11 SET DIKKDA(1)=DA
+12 SET DIKKDA=0
FOR
SET DIKKDA=$ORDER(^DD("KEY",DA,2,DIKKDA))
if 'DIKKDA
QUIT
Begin DoDot:1
+13 SET DIKKSQ=$$GET^DDSVAL(.312,.DIKKDA,1)
+14 IF $DATA(DIKKLIST(DIKKSQ))
Begin DoDot:2
+15 if '$DATA(DDSERROR)
DO MSG^DDSUTL($CHAR(7)_"UNABLE TO SAVE CHANGES")
+16 SET DDSERROR=1
+17 DO MSG^DDSUTL("The sequence number "_DIKKSQ_" is used more than once.")
End DoDot:2
+18 IF '$TEST
SET DIKKLIST(DIKKSQ,DIKKDA)=""
End DoDot:1
+19 ;
+20 ;If no duplicates, check that sequence numbers are consecutive from 1
+21 IF '$DATA(DDSERROR)
Begin DoDot:1
+22 SET DIKKSQ=0
+23 FOR DIKKI=1:1
SET DIKKSQ=$ORDER(DIKKLIST(DIKKSQ))
if 'DIKKSQ!$GET(DDSERROR)
QUIT
if DIKKSQ'=DIKKI
Begin DoDot:2
+24 SET DDSERROR=1
+25 DO MSG^DDSUTL($CHAR(7)_"UNABLE TO SAVE CHANGES")
+26 DO MSG^DDSUTL("Sequence numbers must be consecutive numbers starting with 1.")
End DoDot:2
End DoDot:1
+27 QUIT
+28 ;
NAMEPAC ;Post-Action on Change for Name of Key
+1 NEW DIKKSD,DIKKUI
+2 ;
+3 SET DIKKUI=$$GET^DDSVAL(.31,DA,3)
if 'DIKKUI
QUIT
+4 SET DIKKSD=$$GET^DDSVAL(.11,DIKKUI,.11)
+5 if DIKKSD'?1"Uniqueness Index for Key '"1A1"'".E
QUIT
+6 ;
+7 SET $EXTRACT(DIKKSD,27)=X
+8 DO PUT^DDSVAL(.11,DIKKUI,.11,DIKKSD)
+9 QUIT
