MESSAGE "Writing utility procedures to library..."

PROC Edit_Mode()
  if (SYSMODE() = "Main") then
    COEDITKEY
    MENUDISABLE "Edit\Mode"
    MENUDISABLE "Reports"
    MENUENABLE  "Main\Mode"
  endif
  RETURN 1                         
ENDPROC
WRITELIB Off_Lib Edit_Mode

PROC Main_Mode()
  if (HELPMODE() = "LookupHelp") then  ; if user in lookup help and pressed
    RETURN 0                           ; F2 to select, do not exit wait loop
  endif  
  if NOT ISVALID() then     ; if in coedit and field data is not valid,
    MESSAGE "Error: The data for this field is not valid."
    RETURN 1                ; do not exit wait
  endif  
  if ISFIELDVIEW() then          
    DO_IT!
    RETURN 1
  endif  
  DO_IT!
  if (SYSMODE() = "Main") then     ; record posted successfully
    MENUDISABLE "Main\Mode"
    MENUENABLE  "Edit\Mode"
    MENUENABLE  "Reports"
  else ECHO NORMAL                 ; key violation exists
       DO_IT!
  endif       
  RETURN 1
ENDPROC
WRITELIB Off_Lib Main_Mode

PROC Clear_Table()
  if (SYSMODE() = "CoEdit") then
    Main_Mode()
  endif
  if (SYSMODE() = "Main") then
    ECHO OFF
    CLEARIMAGE
    ECHO NORMAL     
    RETURN 2                     ; back in main mode so exit wait
    else RETURN 1                ; cannot get to main mode - wait continues
  endif
ENDPROC
WRITELIB Off_Lib Clear_Table

PROC Sound_Off()
  PRIVATE HTZ, I
  HTZ = 200
  FOR I FROM 1 TO 4
    SOUND HTZ 100
    HTZ = HTZ + 100
  ENDFOR
ENDPROC
WRITELIB Off_Lib Sound_Off

PROC Get_Custom_Setup_Variables()
  PRIVATE I
  if ISTABLE("Setup") then
    VIEW "Setup"
    TAB
    Appl_Title = []
    FOR I FROM 1 TO ARRAYSIZE(Ltr_Hd)
      TAB
      Ltr_Hd[I] = []
    ENDFOR
    TAB
    I = []    ; default printer
    CLEARIMAGE; clear setup table
    RETURN I
    else Appl_Title = "DELPHI CONSULTING GROUP, INC."
         FOR I FROM 1 TO ARRAYSIZE(Ltr_Hd)
           TAB
           Ltr_Hd[I] = ""
         ENDFOR
         RETURN ""
  endif  
ENDPROC
WRITELIB Off_Lib Get_Custom_Setup_Variables

PROC Customize_Setup()
  PRIVATE Button_Val, A_Title, LH, I

  PROC Update_Setup()
    Appl_Title = A_Title
    FOR I FROM 1 TO ARRAYSIZE(Ltr_Hd)
      Ltr_Hd[I] = LH[I]
    ENDFOR
  ENDPROC

  PROC Save_Setup()
    if ISTABLE("Setup") then
      ECHO OFF
      COEDIT "Setup"
      TAB
      [] = Appl_Title
      FOR I FROM 1 TO ARRAYSIZE(Ltr_Hd)
        TAB
        [] = Ltr_Hd[I]
      ENDFOR
      DO_IT!
      CLEARIMAGE; clear setup table
      ECHO NORMAL
      Message_Box("Saving Setup Variables", "Setup variables have been saved.")
      else RETURN ; create table if it doesn't exist
    endif  
  ENDPROC; Save_Setup

  I = ARRAYSIZE(Ltr_Hd)
  ARRAY LH[I]
  A_Title = Appl_Title  ; assign global values to temp variables
  FOR I FROM 1 TO ARRAYSIZE(Ltr_Hd)
    LH[I] = Ltr_Hd[I]
  ENDFOR
  MOUSE SHOW
  SHOWDIALOG "System Setup Variables"
    @2,5 HEIGHT 19 WIDTH 70
    @1,2 ?? "Title of Organization"
    ACCEPT @2,2 WIDTH 53 "A50"
      TAG "A_Title"
      TO A_Title
    @3,2 ?? "Statement Letterhead (10 Lines, each centered automatically)"
    ACCEPT @4,2 WIDTH 64 "A80"
      TAG "L1"
      TO LH[1]
    ACCEPT @5,2 WIDTH 64 "A80"
      TAG "L2"
      TO LH[2]
    ACCEPT @6,2 WIDTH 64 "A80"
      TAG "L3"
      TO LH[3]
    ACCEPT @7,2 WIDTH 64 "A80"
      TAG "L4"
      TO LH[4]
    ACCEPT @8,2 WIDTH 64 "A80"
      TAG "L5"
      TO LH[5]
    ACCEPT @9,2 WIDTH 64 "A80"
      TAG "L6"
      TO LH[6]
    ACCEPT @10,2 WIDTH 64 "A80"
      TAG "L7"
      TO LH[7]
    ACCEPT @11,2 WIDTH 64 "A80"
      TAG "L8"
      TO LH[8]
    ACCEPT @12,2 WIDTH 64 "A80"
      TAG "L9"
      TO LH[9]
    ACCEPT @13,2 WIDTH 64 "A80"
      TAG "L10"
      TO LH[10]
    PUSHBUTTON @15,7 WIDTH 10
      "~O~K"
      OK
      DEFAULT
      VALUE "OK"      
      TAG "OK_Button"
      TO Button_Val
    PUSHBUTTON @15,22 WIDTH 10
      "~S~ave"
      OK
      VALUE "SAVE"
      TAG "Save_Button"
      TO Button_Val
    PUSHBUTTON @15,37 WIDTH 10
      "~R~eset"
      OK
      VALUE "RESET"
      TAG "Reset_Button"
      TO Button_Val
    PUSHBUTTON @15,52 WIDTH 10
      "~C~ancel"
      CANCEL   
      VALUE "CANCEL"
      TAG "Cancel_Button"
      TO Button_Val
  ENDDIALOG      
  if RetVal then
    SWITCH
      CASE (Button_Val = "OK")     : Update_Setup()
      CASE (Button_Val = "SAVE")   : Update_Setup()
                                     Save_Setup()
      CASE (Button_Val = "RESET")  : ECHO OFF
                                     Get_Custom_Setup_Variables()
                                     ECHO NORMAL
                                     Message_Box("Reset Setup Variables", "Setup variables reset to previously saved values.")
    ENDSWITCH  
  endif
  MOUSE HIDE
ENDPROC
WRITELIB Off_Lib Customize_Setup

PROC Message_Box(Title, Message_String)
  PRIVATE Button_Val
  MESSAGE ""
  SHOWDIALOG Title
    @8,10 HEIGHT 7 WIDTH 60
    @1,0 ?? FORMAT("W58,AC", Message_String)
    PUSHBUTTON @3,22 WIDTH 12
      "~O~K"
      OK
      VALUE "OK"
      TAG "OK_Button"
    TO Button_Val
  ENDDIALOG      
ENDPROC
WRITELIB Off_Lib Message_Box

PROC Yes_No_Cancel(Title, Question)
  PRIVATE Button_Val
  SHOWDIALOG Title
    @8,10 HEIGHT 7 WIDTH 60
    @1,0 ?? FORMAT("W58,AC", Question)
    PUSHBUTTON @3,6 WIDTH 12
      "~Y~es"
      OK
      VALUE "Yes"
      TAG "Y_B"
    TO Button_Val
    PUSHBUTTON @3,22 WIDTH 12
      "~N~o"
      OK
      VALUE "No"
      TAG "N_B"
    TO Button_Val
    PUSHBUTTON @3,38 WIDTH 12
      "~C~ancel"
      CANCEL
      VALUE "Cancel"
      TAG "C_B"
    TO Button_Val
  ENDDIALOG    
  if Retval then  
    RETURN Button_Val
    else RETURN "Cancel"
  endif  
ENDPROC
WRITELIB Off_Lib Yes_No_Cancel

PROC Response_Is_Yes(Title, Question)
  PRIVATE Button_Val
  SHOWDIALOG Title
    @8,10 HEIGHT 7 WIDTH 60
    @1,0 ?? FORMAT("W58,AC", Question)
    PUSHBUTTON @3,14 WIDTH 12
      "~Y~es"
      OK
      VALUE "OK"
      TAG "OK_Button"
    TO Button_Val
    PUSHBUTTON @3,32 WIDTH 12
      "~N~o"
      CANCEL
      VALUE "Cancel"
      TAG "Cancel_Button"
    TO Button_Val
  ENDDIALOG      
  if (RetVal = TRUE) then
    RETURN TRUE
    else RETURN FALSE
  endif   
ENDPROC
WRITELIB Off_Lib Response_Is_Yes

PROC Display_Delete_Box()
  if ISFIELDVIEW() then
    RETURN 0
  endif  
  if Response_Is_Yes("Confirm Deletion", "Are you sure you want to delete this entry?") then
    DEL
  endif
  RETURN 1
ENDPROC
WRITELIB Off_Lib Display_Delete_Box

PROC No_Matches_Found()
  Sound_Off()
  Message_Box("Negative Search Results", "No matches were found using chosen criteria.")
ENDPROC
WRITELIB Off_Lib No_Matches_Found

PROC Printer_Ready()
  WHILE (PRINTERSTATUS() <> True)
    BEEP
    if Response_Is_Yes("Printer Error", "Printer not ready - please check.  Retry?") then
      else RETURN FALSE
    endif
  ENDWHILE
  RETURN TRUE
ENDPROC
WRITELIB Off_lib Printer_Ready

PROC Valid_Filename()
  PRIVATE Button_Val
  if ISFILE("ANSWER.RPT") then
    Base_Name = ""
    else Base_Name = "ANSWER"
  endif
  WHILE TRUE
    SHOWDIALOG "File Name for Report"
      @8,20 HEIGHT 8 WIDTH 40
      ACCEPT @1,14 WIDTH 11 "A8" PICTURE "*&"
        TAG "Disk_File"
        TO Base_Name
      @2,1 ?? FORMAT("W37,AC", "(Extension .RPT is assumed)")
      PUSHBUTTON @4,7 WIDTH 10
        "~O~K"
        OK
        DEFAULT
        VALUE "OK"
        TAG "OK_Button"
      TO Button_Val
      PUSHBUTTON @4,22 WIDTH 10
        "~C~ancel"
        CANCEL
        VALUE "Cancel"
        TAG "Cancel_Button"
      TO Button_Val
    ENDDIALOG      
    if RetVal And NOT ISBLANK(Base_Name) then
      File_Name = Base_Name + ".RPT"
      if ISFILE(File_Name) then
        MOUSE SHOW
        SHOWDIALOG "Replace Existing File"
          @8,15 HEIGHT 7 WIDTH 50
          @1,2 ?? FORMAT("W44,AC",(File_Name + " already exists. Replace?"))
          PUSHBUTTON @3,8 WIDTH 10
            "~Y~es"
            OK
            DEFAULT
            VALUE "YES"
            TAG "Yes_Button"
          TO Button_Val
          PUSHBUTTON @3,20 WIDTH 10
            "~N~o"
            CANCEL
            VALUE "NO"
            TAG "No_Button"
          TO Button_Val
          PUSHBUTTON @3,32 WIDTH 10
            "~R~etry"
            OK
            VALUE "RETRY"
            TAG "Retry_Button"
          TO Button_Val
        ENDDIALOG      
        MOUSE HIDE
        if RetVal then
          SWITCH
            CASE (Button_Val = "YES")    : RETURN TRUE
            CASE (Button_Val = "NO")     : RETURN FALSE
            CASE (Button_Val = "RETRY")  : LOOP
            OTHERWISE                    : RETURN FALSE
          ENDSWITCH  
          else RETURN FALSE; user pressed escape
        endif
        else RETURN TRUE
      endif; if file already exists
      else RETURN FALSE
    endif
  ENDWHILE  
ENDPROC
WRITELIB Off_Lib Valid_Filename

PROC Setup_Printer(Number)
  PRIVATE R
  SHOWPULLDOWN
  ENDMENU
  CLEARSPEEDBAR
  ECHO OFF
  GETRECORD "Printers" Number TO DYNARRAY R
  CLEARIMAGE
  if RetVal then
    if NOT ISBLANK(R["Port"]) then
      {Report} {SetPrinter} {Override} {PrinterPort} TYPEIN R["Port"] ENTER 
    endif
    if NOT ISBLANK(R["Page_Break"]) then
      {Report} {SetPrinter} {Override} {EndOfPage} TYPEIN SUBSTR(R["Page_Break"],1,1)
    endif  
    {Report} {SetPrinter} {Override} {Setup}
    if ISBLANK(R["Setup_St"]) then
      CTRLBACKSPACE
      else TYPEIN R["Setup_St"]
    endif
    ENTER
    {Report} {SetPrinter} {Override} {Reset}
    if ISBLANK(R["Reset_St"]) then
      CTRLBACKSPACE
      else TYPEIN R["Reset_St"]
    endif
    ENTER
    if ISTABLE("Setup") then
      COEDIT "Setup"
      [Default_Printer] = Number
      DO_IT!
      CLEARIMAGE; clear setup table
    endif  
    Default_Printer = Number
    FOREACH Element in Rpt_St
      if ISASSIGNED(R[Element]) AND NOT ISBLANK(R[Element]) then
        Rpt_St[Element] = R[Element]
        else Rpt_St[Element] = ""
      endif  
    ENDFOREACH  
    ECHO NORMAL
    RETURN TRUE
  endif  
  ECHO NORMAL
  RETURN FALSE
ENDPROC
WRITELIB Off_Lib Setup_Printer

PROC Select_Printer()
  PRIVATE Button_Val, P_Array, P_Number
  if NOT ISTABLE("Printers") then
    Message_Box("Selection Error", "No printer table was found.")
    RETURN
  endif
  if ISEMPTY("Printers") then
    Message_Box("Selection Error", "Printer table has no printer entries.")
    RETURN
  endif
  ECHO OFF
  VIEW "Printers"
  DYNARRAY P_Array[]
  SCAN
    P_Array[([Number])] = STRVAL([Number]) + " " + [Name]
  ENDSCAN
  CLEARIMAGE
  P_Number = Default_Printer
  MOUSE SHOW
  SHOWDIALOG "Select Default Printer"
    @5,16 HEIGHT 13 WIDTH 45
    PICKDYNARRAY @1,5 HEIGHT 7 WIDTH 34
      P_Array
      TAG "P_Array"
      TO   P_Number
    PUSHBUTTON @9,8 WIDTH 10
      "~O~K"
      OK
      DEFAULT
      VALUE "YES"
      TAG "Yes_Button"
      TO   Button_Val
    PUSHBUTTON @9,26 WIDTH 10
      "~C~ancel"
      CANCEL
      VALUE "NO"
      TAG "No_Button"
      TO   Button_Val
  ENDDIALOG      
  MOUSE HIDE
  if RetVal then
    Setup_Printer(NUMVAL(P_Number))
  endif
  ECHO NORMAL
ENDPROC
WRITELIB Off_Lib Select_Printer

PROC Print_Report(T_Tbl, Rpt_Num, R_St)
  ; allow user to select from list of available quick reports & destination
  PRIVATE Destination, Base_Name, File_Name, B_Underline, E_Underline, B_Bold, E_Bold

  PROC Esc_Sequence(Orig_St)
  PRIVATE Temp_St, A
    Temp_St = ""
    WHILE MATCH(Orig_St, "..\\027..", A, Orig_St)
      Temp_St = Temp_St + A + CHR(27)
    ENDWHILE  
    Temp_St = Temp_St + Orig_St
    RETURN Temp_St
  ENDPROC; Esc_Sequence

  B_Bold      = Esc_Sequence(Rpt_St["B_BOLD"])
  E_Bold      = Esc_Sequence(Rpt_St["E_Bold"])
  B_Underline = Esc_Sequence(Rpt_St["B_Underline"])
  E_Underline = Esc_Sequence(Rpt_St["E_Underline"])
  SHOWPULLDOWN
  ENDMENU
  CLEARSPEEDBAR
  MESSAGE ""
  SHOWPOPUP "Report Destination" CENTERED
    "Printer"   : "Send report to printer"            : "Printer",
    "Screen"    : "Preview report on screen"          : "Screen",
    "Disk File" : "Save file on disk in ASCII format" : "Disk",
    SEPARATOR,
    "Cancel"    : "Abort printing and return to previous work"   : "Cancel"
  ENDMENU
  TO Destination
  SWITCH
    CASE (Destination = "Printer") : 
      if Printer_Ready() then
        MESSAGE "Sending report to printer..."
        OPEN PRINTER
        if ISASSIGNED(R_St) AND NOT ISBLANK(R_St) then
          PRINT Esc_Sequence(R_St); individual report setup string
        endif  
        REPORT T_Tbl Rpt_Num
        CLOSE PRINTER
      endif  
    CASE (Destination = "Screen") : 
      MESSAGE "Sending report to screen..."
      PROMPT  " Use cursor keys to navigate.  F2 to quit."
      {Report} {Output} TYPEIN T_Tbl ENTER TYPEIN Rpt_Num ENTER {Screen}
    CASE (Destination = "Disk") : 
      if Valid_Filename() then
        MESSAGE "Sending report to file: " + File_Name + "..."
        if ISFILE(File_Name) then
          {Report} {Output} TYPEIN T_Tbl ENTER TYPEIN Rpt_Num ENTER {File} 
          TYPEIN File_Name ENTER {Replace}
          else {Report} {Output} TYPEIN T_Tbl ENTER TYPEIN Rpt_Num ENTER {File} 
               TYPEIN File_Name ENTER
        endif  
      endif  
    OTHERWISE :
  ENDSWITCH
  MESSAGE ""
  ECHO NORMAL                   ; echo original image table
  RETURN 1
ENDPROC
WRITELIB Off_Lib Print_Report

PROC Update_Calendar()
  PRIVATE
    M_Tbl, D_Tbl, Temp_Tbl, To_Date
  M_Tbl    = "Calndr"
  D_Tbl    = "Apoint"
  To_Date  = TODAY() - 30
  MESSAGE "Transferring old calendar entries to archive calendar..."
  ECHO OFF
  ; extract old appointment records
  {Ask} TYPEIN M_Tbl ENTER
  TAB TAB EXAMPLE "LINK"              ; link to Day field
  TYPEIN ", <=" + STRVAL(To_Date)
  {Ask} TYPEIN D_Tbl ENTER CHECKPLUS
  TAB TAB EXAMPLE "LINK"              ; link to day field
  DO_IT!
  Temp_Tbl = PRIVDIR() + TABLE()
  if NOT ISEMPTY(Temp_Tbl) then
    ADD Temp_Tbl "Apoint_x"
    SUBTRACT Temp_Tbl D_Tbl
  endif
  CLEARALL
  ; extract old calendar records
  {Ask} TYPEIN M_Tbl ENTER CHECKPLUS
  TAB TAB TYPEIN " <=" + STRVAL(To_Date)
  DO_IT!
  Temp_Tbl = PRIVDIR() + TABLE()
  if NOT ISEMPTY(Temp_Tbl) then
    ADD Temp_Tbl "Calndr_x"
    SUBTRACT Temp_Tbl M_Tbl
  endif
  MESSAGE ""
  CLEARALL
  ECHO NORMAL
ENDPROC
WRITELIB Off_lib Update_Calendar

PROC Organize()
  PRIVATE O_Files, A_Files, O_Ledger, A_Ledger
  
    PROC Transfer(Sub_From, Add_To)
      PRIVATE Tbl
      DO_IT!
      Tbl = PRIVDIR() + TABLE()
      if NOT ISEMPTY(Tbl) then
        MESSAGE "Moving " + STRVAL(NRECORDS(Tbl)) + " records from " + Sub_From + " table to " + Add_To + " table"
        if (Sub_From = O_Files) then
          COEDITKEY
          SCAN
            if ISBLANK([Closed]) then
              [Closed] = TODAY()
            endif
          ENDSCAN
          DO_IT!    
        endif
        ADD Tbl Add_To
        SUBTRACT Tbl Sub_From
        MESSAGE ""
      endif
      CLEARALL
    ENDPROC;  Transfer

    PROC Select_Records(F_Source, F_Target, L_Source, L_Target, Status_St)
      ; move ledger source records to ledger target
      {Ask} TYPEIN F_Source ENTER   ; file table linked to detail tables
      TAB EXAMPLE "LINK"
      MOVETO FIELD "STATUS"
      TYPEIN Status_St
      {Ask} TYPEIN L_Source ENTER 
      CHECKPLUS TAB EXAMPLE "LINK"
      Transfer(L_Source, L_Target)
      ; move file source records to file target
      {Ask} TYPEIN F_Source ENTER CHECKPLUS
      MOVETO FIELD "STATUS"
      TYPEIN Status_St
      Transfer(F_Source, F_Target)
    ENDPROC; Select_Records
  
  ECHO OFF    
  O_Files  = "Files"
  A_Files  = "Files_x"
  O_Ledger = "Ledger"
  A_Ledger = "Ledger_x"
  ; move archive status file cabinet records from open file table to archive file table
  Select_Records(O_Files, A_Files, O_Ledger, A_Ledger, "ARCHIVE")
  ; move non-archive status file cabinet records from archive file table to open file table
  Select_Records(A_Files, O_Files, A_Ledger, O_Ledger, "NOT ARCHIVE")
  ECHO NORMAL
  Sound_Off()
  Message_Box("Operation Completed", "File Cabinets have been reorganized.")
ENDPROC
WRITELIB Off_Lib Organize

RELEASE PROCS ALL