;-------------------------------------------------------------
; KTODAY.SC                                Paradox for DOS
; (with thanks to Harry Goldman, Buffalo Grove, IL)
;
; This script will work only with field type, D - Date
;
; Use the SETKEY command to bind this script to the {Alt-T} key.
; For example, in a script use the following command:
;
; SetKey -20 Play "Ktoday"
;
; This script tests for the following conditions:
;  - There must be a display image of the workspace
;    (Table view or form view)
;  - The current field must be Date type
;  - The current field must be blank
;  - The user must be in EDIT or COEDIT or DATAENTRY mode
;  - The user can't be in FieldView mode
;
; An Error Procedure is defined to capture errors that could be
; caused 'after the fact'.
;
;-------------------------------------------------------------
Proc TodError()
private Err.n
Err.n = ErrorCode()
Switch
  Case Err.n = 23 :
    Beep
    Message "Invalid Field Value: Validity checks prevent date entry?"
    Sleep 3000
    Return 1
  Case Err.n = 20 :
    Beep
    Message "No Table Is On The Workspace"
    Sleep 3000
    Return 1
Endswitch
Endproc

Proc Tod()
private Quit.l, Errorproc
Quit.l = False
Errorproc = "TodError"
Switch
  Case ImageType() <> "Display"     : Quit.l = True
  Case Fieldtype() <> "D"           : Quit.l = True
  Case IsFieldView()                : Quit.l = True
  Case Not Isblank([])              : Quit.l = True
  Case Search("EDIT",Upper(Sysmode())) < 1
       and Upper(Sysmode()) <> "DATAENTRY" : Quit.1 = True
Endswitch
If Quit.l Then
  Beep
  Quit
Endif
[] = Today()
EndProc
Today()