- 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 Jan 18, 2025@03:50:07 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)