hotswap/delphi-database-v2
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Initial project structure: directories, empty files, requirements.txt, and logo

Browse Source
This commit is contained in:
HotSwapp
2025-10-06 18:18:47 -05:00
commit 36dffd5372
113 changed files with 7103 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

621
old-database/UTILITY.SC Executable file
View File

@@ -0,0 +1,621 @@
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