DIKKUTL4 ;SFISC/MKO-KEY DEFINITION, READER PROMPTS ;10:01 AM 15 Jul 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.
;
;==================
; $$RORM(ufld,fld)
;==================
;Prompt for method to resolve difference between fields in key
;and fields in uniqueness index.
; Called from EDIT when key fields and UI fields don't match.
;In:
; $G(DIKKUFLD) : include option 2 (there are UI fields)
; $G(DIKKFLD) : include option 3 (there are key fields)
;Returns:
; 1 : Re-edit the key
; 2 : Make key match UI (default on ^, timeout when UI fields exist)
; 3 : Make UI match key (default on ^, timeout when no UI fields)
;
RORM(DIKKUFLD,DIKKFLD) ;
N DIKKOPT,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
W !!,"The Key fields and the fields in the Uniqueness Index don't match."
S DIR(0)="S^1:Re-Edit the Key",DIKKOPT=1
S:$G(DIKKUFLD) DIKKOPT=2,DIR(0)=DIR(0)_";2:Make Key match Uniqueness Index (also selected on up-arrow)"
S:$G(DIKKFLD) DIKKOPT=DIKKOPT+1,DIR(0)=DIR(0)_";"_DIKKOPT_":Make Uniqueness Index match Key"_$S(DIKKOPT=2:" (also selected on up-arrow)",1:"")
D ^DIR
I '$G(DIKKUFLD) Q $S($D(DIRUT):3,Y=2:3,1:Y)
Q $S($D(DIRUT):2,1:Y)
;
;===========================
; $$EDORD(KeyIdString,flag)
;===========================
;Prompt edit or delete the key.
; Called from EDIT^DIKKUTL when there are no key fields and
; either no Uniqueness Index or no UI fields.
;In:
; DIKKID = string that identifies the key -- used in message
; DIKKFL = controls message (there are neither key nor UI fields)
;Returns:
; 1 : Re-edit the key
; 2 : Delete the key (default on ^, timeout)
;
EORD(DIKKID,DIKKFL) ;Choose to edit or delete the key.
N DIKKMSG,DIR,DIROUT,DIRUT,DTOUT,DUOUT,I,X,Y
;
;Write message that key definition is incomplete
I '$G(DIKKFL) S DIKKMSG(0)=$C(7)_"NOTE: "_DIKKID_" has neither fields nor a Uniqueness Index defined."
E S DIKKMSG(0)=$C(7)_"NOTE: "_DIKKID_" and its Uniqueness Index have no fields defined."
D WRAP^DIKCU2(.DIKKMSG,-7,0)
W ! F I=0:1 Q:'$D(DIKKMSG(I)) W !,@$S(I:"?6",1:"?0"),DIKKMSG(I)
;
;Prompt 'Re-edit' or 'Delete'
S DIR(0)="S^1:Re-edit the Key;2:Delete the Key (also selected on up-arrow)"
D ^DIR
Q $S($D(DIRUT):2,1:Y)
;
;==========
; $$EDORC
;==========
;Prompt whether edit key, delete key, or create a Uniqueness Index.
; Called from EDIT^DIKKUTL when the user chose to create a new UI
; but failed to provide a name for that Index.
;Returns:
; 1 : Re-edit the key
; 2 : Delete the key (default on ^, timeout)
; 3 : Create a new Uniqueness Index
;
EDORC() ;Choose to edit key, delete key, or create a Uniqueness Index
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
;
W !,$C(7)_"NOTE: All Keys must have a Uniqueness Index defined."
S DIR(0)="S^1:Re-edit the Key;2:Delete the Key (also selected on up-arrow);3:Create a Uniqueness Index"
S DIR("?")="All Keys must have a Uniqueness index defined."
D ^DIR
Q $S($D(DIRUT):2,1:Y)
;
;==========
; $$EDORI
;==========
;Prompt whether to delete, re-edit, or ignore
; Called from EDIT^DIKKUTL when the key fails integrity check.
;Returns:
; 1 : Delete the Key
; 2 : Re-Edit the Key
; 3 : Ignore problem
;
EDORI() ;Choose to edit key, delete key, or create a Uniqueness Index
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
;
W !!,$C(7)_"ERROR: The key is not unique and/or some records have key field values missing."
S DIR(0)="S^1:Delete the Key (also selected on up-arrow);2:Re-Edit the Key;3:Ignore problem (Be sure to fix later)"
S DIR("?")="The Key is invalid because it is not unique and/or some records have missing key field values."
D ^DIR
Q $S($D(DIRUT):1,1:Y)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIKKUTL4 3951 printed Dec 13, 2024@02:49:09 Page 2
DIKKUTL4 ;SFISC/MKO-KEY DEFINITION, READER PROMPTS ;10:01 AM 15 Jul 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 ; $$RORM(ufld,fld)
+9 ;==================
+10 ;Prompt for method to resolve difference between fields in key
+11 ;and fields in uniqueness index.
+12 ; Called from EDIT when key fields and UI fields don't match.
+13 ;In:
+14 ; $G(DIKKUFLD) : include option 2 (there are UI fields)
+15 ; $G(DIKKFLD) : include option 3 (there are key fields)
+16 ;Returns:
+17 ; 1 : Re-edit the key
+18 ; 2 : Make key match UI (default on ^, timeout when UI fields exist)
+19 ; 3 : Make UI match key (default on ^, timeout when no UI fields)
+20 ;
RORM(DIKKUFLD,DIKKFLD) ;
+1 NEW DIKKOPT,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+2 WRITE !!,"The Key fields and the fields in the Uniqueness Index don't match."
+3 SET DIR(0)="S^1:Re-Edit the Key"
SET DIKKOPT=1
+4 if $GET(DIKKUFLD)
SET DIKKOPT=2
SET DIR(0)=DIR(0)_";2:Make Key match Uniqueness Index (also selected on up-arrow)"
+5 if $GET(DIKKFLD)
SET DIKKOPT=DIKKOPT+1
SET DIR(0)=DIR(0)_";"_DIKKOPT_":Make Uniqueness Index match Key"_$SELECT(DIKKOPT=2:" (also selected on up-arrow)",1:"")
+6 DO ^DIR
+7 IF '$GET(DIKKUFLD)
QUIT $SELECT($DATA(DIRUT):3,Y=2:3,1:Y)
+8 QUIT $SELECT($DATA(DIRUT):2,1:Y)
+9 ;
+10 ;===========================
+11 ; $$EDORD(KeyIdString,flag)
+12 ;===========================
+13 ;Prompt edit or delete the key.
+14 ; Called from EDIT^DIKKUTL when there are no key fields and
+15 ; either no Uniqueness Index or no UI fields.
+16 ;In:
+17 ; DIKKID = string that identifies the key -- used in message
+18 ; DIKKFL = controls message (there are neither key nor UI fields)
+19 ;Returns:
+20 ; 1 : Re-edit the key
+21 ; 2 : Delete the key (default on ^, timeout)
+22 ;
EORD(DIKKID,DIKKFL) ;Choose to edit or delete the key.
+1 NEW DIKKMSG,DIR,DIROUT,DIRUT,DTOUT,DUOUT,I,X,Y
+2 ;
+3 ;Write message that key definition is incomplete
+4 IF '$GET(DIKKFL)
SET DIKKMSG(0)=$CHAR(7)_"NOTE: "_DIKKID_" has neither fields nor a Uniqueness Index defined."
+5 IF '$TEST
SET DIKKMSG(0)=$CHAR(7)_"NOTE: "_DIKKID_" and its Uniqueness Index have no fields defined."
+6 DO WRAP^DIKCU2(.DIKKMSG,-7,0)
+7 WRITE !
FOR I=0:1
if '$DATA(DIKKMSG(I))
QUIT
WRITE !,@$SELECT(I:"?6",1:"?0"),DIKKMSG(I)
+8 ;
+9 ;Prompt 'Re-edit' or 'Delete'
+10 SET DIR(0)="S^1:Re-edit the Key;2:Delete the Key (also selected on up-arrow)"
+11 DO ^DIR
+12 QUIT $SELECT($DATA(DIRUT):2,1:Y)
+13 ;
+14 ;==========
+15 ; $$EDORC
+16 ;==========
+17 ;Prompt whether edit key, delete key, or create a Uniqueness Index.
+18 ; Called from EDIT^DIKKUTL when the user chose to create a new UI
+19 ; but failed to provide a name for that Index.
+20 ;Returns:
+21 ; 1 : Re-edit the key
+22 ; 2 : Delete the key (default on ^, timeout)
+23 ; 3 : Create a new Uniqueness Index
+24 ;
EDORC() ;Choose to edit key, delete key, or create a Uniqueness Index
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+2 ;
+3 WRITE !,$CHAR(7)_"NOTE: All Keys must have a Uniqueness Index defined."
+4 SET DIR(0)="S^1:Re-edit the Key;2:Delete the Key (also selected on up-arrow);3:Create a Uniqueness Index"
+5 SET DIR("?")="All Keys must have a Uniqueness index defined."
+6 DO ^DIR
+7 QUIT $SELECT($DATA(DIRUT):2,1:Y)
+8 ;
+9 ;==========
+10 ; $$EDORI
+11 ;==========
+12 ;Prompt whether to delete, re-edit, or ignore
+13 ; Called from EDIT^DIKKUTL when the key fails integrity check.
+14 ;Returns:
+15 ; 1 : Delete the Key
+16 ; 2 : Re-Edit the Key
+17 ; 3 : Ignore problem
+18 ;
EDORI() ;Choose to edit key, delete key, or create a Uniqueness Index
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+2 ;
+3 WRITE !!,$CHAR(7)_"ERROR: The key is not unique and/or some records have key field values missing."
+4 SET DIR(0)="S^1:Delete the Key (also selected on up-arrow);2:Re-Edit the Key;3:Ignore problem (Be sure to fix later)"
+5 SET DIR("?")="The Key is invalid because it is not unique and/or some records have missing key field values."
+6 DO ^DIR
+7 QUIT $SELECT($DATA(DIRUT):1,1:Y)
