DIKKFORM.m

DIKKFORM ;SFISC/MKO-ENTRY POINTS FOR THE 'DIKC EDIT' FORM ;11:34 AM  16 Nov 1998

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

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

 ;

 ;==========================

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

DIKKFORM  ;SFISC/MKO-ENTRY POINTS FOR THE 'DIKC EDIT' FORM ;11:34 AM  16 Nov 1998

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

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

 +3       ;

 +4       ;==========================

 +5       ; [DIKK EDIT] entry points

 +6       ;==========================

 +7       ;

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