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

BIN
old-database/.DS_Store vendored Normal file
View File

Binary file not shown.

409
old-database/DEPOSITS.SC Executable file
View File

@@ -0,0 +1,409 @@
MESSAGE "Writing deposit procedures to library..."
PROC CLOSED Deposit_Table_Wait(M_Tbl, R, C, F_Num)
USEVARS Autolib, Rpt_St
PRIVATE Answer_Menu, Fld_Prompt, Old_Amt, New_Amt
DYNARRAY Fld_Prompt[]
PROC Ask_Deposit_Book()
PRIVATE
File_No, Id, Re, From_Date, To_Date, Button
File_No = ""
Id = ""
Re = ""
From_Date = ""
To_Date = ""
FORMKEY
SHOWPULLDOWN
ENDMENU
CLEARSPEEDBAR
PROMPT "Enter selection criteria. Press Search to find matches, Cancel to quit."
MOUSE SHOW
SHOWDIALOG "Deposit Book Selection Criteria"
@4, 15 HEIGHT 15 WIDTH 50
@1, 6 ?? "File No(s)."
ACCEPT @1,20
WIDTH 18 "A60" PICTURE "*!"
TAG ""
TO File_No
@3, 6 ?? "Id(s)"
ACCEPT @3,20
WIDTH 18 "A60" PICTURE "*!"
TAG ""
TO Id
@5, 6 ?? "Regarding"
ACCEPT @5,20
WIDTH 18 "A60" PICTURE "*!"
TAG ""
TO Re
@7, 6 ?? "From Date"
ACCEPT @7,20
WIDTH 11 "D" PICTURE "#[#]/##/##"
TAG ""
TO From_Date
@9, 6 ?? "To Date"
ACCEPT @9,20
WIDTH 11 "D" PICTURE "#[#]/##/##"
TAG ""
TO To_Date
PUSHBUTTON @11,12 WIDTH 10
"~S~earch"
OK
DEFAULT
VALUE ""
TAG "OK"
TO Button
PUSHBUTTON @11,25 WIDTH 10
"~C~ancel"
CANCEL
VALUE ""
TAG "Cancel"
TO Button
ENDDIALOG
PROMPT ""
RETURN
if (RetVal = True) then
MESSAGE "Searching..."
ECHO SLOW
{Ask} TYPEIN "PAYMENTS" ENTER CHECK
if NOT ISBLANK(From_Date) then
TYPEIN (">= " + STRVAL(From_Date))
endif
if NOT ISBLANK(From_Date) And NOT ISBLANK(To_Date) then
TYPEIN (", ")
endif
if NOT ISBLANK(To_Date) then
TYPEIN ("<= " + STRVAL(To_Date))
endif
[File_No] = File_No
[Id] = Id
[Regarding] = Regarding
DO_IT!
Subset_Table = PRIVDIR() + "SUBSET"
RENAME TABLE() Subset_Table
MOVETO ("Payments(Q)")
CLEARIMAGE ; erase query image
MOVETO Subset_Table
if ISEMPTY(Subset_Table) then
CLEARIMAGE
No_Matches_Found()
else ; copy form and display on screen
COPYFORM "Payments" "2" Subset_Table "1"
View_Answer_Table(Subset_Table, 4, 0)
SLEEP 10000
; Payments_Answer_Wait()
endif
endif
FORMKEY
MOUSE HIDE
ENDPROC; Ask_Deposit_Book
PROC Edit_Mode_Menu()
MENUENABLE "Main\Mode"
MENUDISABLE "Edit\Mode"
MENUDISABLE "Reports"
ENDPROC; Edit_Mode_Menu
PROC Main_Mode_Menu()
MENUENABLE "Edit\Mode"
MENUENABLE "Reports"
MENUDISABLE "Main\Mode"
ENDPROC; Main_Mode_Menu
PROC Edit_Mode()
if (SYSMODE() = "Main") then
COEDITKEY
Edit_Mode_Menu()
Arrive_Row()
Arrive_Field()
NEWWAITSPEC
MESSAGE "MENUSELECT"
TRIGGER "ARRIVEFIELD", "ARRIVEROW", "DEPARTROW"
KEY -60, -66, -83, 43, 45
; DO_IT Clear Delete + -
; F2 F8 DEL
endif
RETURN 1
ENDPROC; Edit_Mode
PROC Main_Mode()
if (HELPMODE() = "LookupHelp") then ; if in lookup help and pressed
RETURN 0 ; F2 to select, do not exit wait loop
endif
if NOT ISVALID() then ; if 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 ; if in field view, exit field view
DO_IT!
RETURN 1
endif
DO_IT! ; return to main mode
if (SYSMODE() = "Main") then ; record posted successfully
Main_Mode_Menu()
Arrive_Field()
NEWWAITSPEC
MESSAGE "MENUSELECT"
TRIGGER "ARRIVEFIELD"
KEY -66, -67
; Clear Edit
; F8 F9
else ECHO NORMAL ; key violation exists
DO_IT!
endif
RETURN 1
ENDPROC; Main_Mode
PROC Arrive_Field()
SPEEDBAR "~F10~ Menu":-68
PROMPT Fld_Prompt[FIELD()]
RETURN 0
ENDPROC; Arrive_Field
PROC Arrive_Row()
RETURN 0
ENDPROC; Arrive_Row
PROC Update_Balances()
PRIVATE Prev_Bal, Rec_No, Row_No
RETURN
ECHO OFF
Rec_No = RECNO()
Row_No = ROWNO()
if ATFIRST() then
[Balance] = [Amount]
else UP
Prev_Bal = [Balance]
DOWN
[Balance] = Prev_Bal + [Amount]
endif
Prev_Bal = [Balance]
WHILE NOT ATLAST()
DOWN
[Balance] = Prev_Bal + [Amount]
Prev_Bal = [Balance]
ENDWHILE
MOVETO RECORD Rec_No
FOR I FROM 1 TO Row_No - 1
UP
ENDFOR
MOVETO RECORD Rec_No
ECHO NORMAL
ENDPROC; Update_Balances
PROC Post_It()
RETURN
if ISBLANK([Item_No]) then
[Item_No] = 1
endif
WHILE TRUE
POSTRECORD NOPOST LEAVELOCKED
if RetVal then
QUITLOOP
else [Item_No] = [Item_No] + 1
endif
ENDWHILE
if (Old_Amt <> [Amount]) then
Update_Balances()
endif
ENDPROC; Post_It
PROC Depart_Row() ; do not leave row if essential information is lacking
RETURN 0
; test for valid field data
if NOT ISVALID() then
Message_Box("Invalid Field Entry", "The data for this field is invalid.")
RETURN 1
endif
; depart row if record is new & blank
if RECORDSTATUS("New") AND NOT RECORDSTATUS("Modified") then
RETURN 0
endif
; delete row if all fields are blank
if ISBLANK([File_No]) AND ISBLANK([Date]) AND ISBLANK([Acnt_No]) AND
ISBLANK([Amount]) AND ISBLANK([Billed]) then
DEL
RETURN 0
endif
; test for missing field entries
if ISBLANK([Date]) then
Message_Box("Incomplete Entry", "This record requires a date for the transaction.")
MOVETO [Date]
PROMPT Fld_Prompt[FIELD()]
RETURN 1
endif
if ISBLANK([File_No]) then
Message_Box("Incomplete Entry", "This record requires a file number for the transaction.")
MOVETO [File_No]
PROMPT Fld_Prompt[FIELD()]
RETURN 1
endif
if ISBLANK([Acnt_No]) then
Message_Box("Incomplete Entry", "This record requires an account number.")
MOVETO [Acnt_No]
PROMPT Fld_Prompt[FIELD()]
RETURN 1
endif
if ISBLANK([Amount]) then
Message_Box("Incomplete Entry", "This record requires an amount.")
MOVETO [Amount]
PROMPT Fld_Prompt[FIELD()]
RETURN 1
endif
if ISBLANK([Billed]) then
Message_Box("Incomplete Entry", "Please enter (Y/N) for billed.")
MOVETO [Billed]
PROMPT Fld_Prompt[FIELD()]
RETURN 1
endif
Post_It() ; post record & update balances if needed
RETURN 0
ENDPROC; Depart_Row
PROC Deposit_Table_Wait_Proc(TriggerType, EventInfo, CycleNumber)
PRIVATE Key_Code, Menu_Pick, Temp_File_No, Temp_Date, Temp_Empl_Num
if (TriggerType = "ARRIVEFIELD") then
RETURN Arrive_Field()
endif
if (TriggerType = "DEPARTFIELD") then
RETURN Depart_Field()
endif
if (TriggerType = "ARRIVEROW") then
RETURN Arrive_Row()
endif
if (TriggerType = "DEPARTROW") then
RETURN Depart_Row()
endif
if (EventInfo["TYPE"] = "MESSAGE") then
Menu_Pick = EventInfo["MENUTAG"]
SWITCH
CASE (Menu_Pick = "Edit\Mode") : RETURN Edit_Mode()
CASE (Menu_Pick = "Main\Mode") : if (Depart_Row() = 0) then
if ISEMPTY(M_Tbl) then
RETURN Clear_Table()
else RETURN Main_Mode()
endif
else RETURN 1
endif
CASE (Menu_Pick = "R_Summary") : ECHO OFF
Print_Report("Payments", "1", "")
Trust_Table_Menu()
Arrive_Field()
RETURN 1
CASE (Menu_Pick = "R_Detailed"): ECHO OFF
Print_Report("Payments", "2", "")
Trust_Table_Menu()
Arrive_Field()
RETURN 1
CASE (Menu_Pick = "R_Cancel") : RETURN 1
CASE (Menu_Pick = "Return\Yes") : if (SYSMODE() = "Main") then
RETURN Clear_Table()
else if (Depart_Row() = 0) then
RETURN Clear_Table()
else RETURN 1
endif
endif
CASE (Menu_Pick = "Return\No") : RETURN 1
OTHERWISE : SOUND 400 100 RETURN 1
ENDSWITCH
endif
if (EventInfo["TYPE"] = "KEY") then
Key_Code = EventInfo["KEYCODE"]
SWITCH
; F9 - COEDIT
CASE (Key_Code = -67) : RETURN Edit_Mode()
; F2 - DO_IT!
CASE (Key_Code = -60) : if (Depart_Row() = 0) then
if ISEMPTY(M_Tbl) then
RETURN Clear_Table()
else RETURN Main_Mode()
endif
else RETURN 1
endif
; F8 - CLEAR
CASE (Key_Code = -66) : if (SYSMODE() = "Main") then
RETURN Clear_Table()
else if (Depart_Row() = 0) then
RETURN Clear_Table()
else RETURN 1
endif
endif
; DELETE
CASE (Key_Code = -83) : if (Display_Delete_Box() = 1) then
Update_Balances()
endif
RETURN 1
; + to add one day to current date
CASE (Key_Code = 43) : RETURN Change_Date(43)
; - to subtract one day from current date
CASE (Key_Code = 45) : RETURN Change_Date(45)
OTHERWISE : SOUND 400 100 RETURN 1
ENDSWITCH
endif
SOUND 400 100 RETURN 1
ENDPROC; Deposit_Table_Wait_Proc
PROC Main_Mode_Wait()
Arrive_Field()
WAIT TABLE
PROC "Deposit_Table_Wait_Proc"
MESSAGE "MENUSELECT"
TRIGGER "ARRIVEFIELD"
KEY -66, -67
; Clear Edit
; F8 F9
ENDWAIT
ENDPROC; Main_Mode_Wait
PROC Edit_Mode_Wait()
Arrive_Row()
Arrive_Field()
WAIT TABLE
PROC "Deposit_Table_Wait_Proc"
MESSAGE "MENUSELECT"
TRIGGER "ARRIVEFIELD", "ARRIVEROW", "DEPARTROW"
KEY -60, -66, -83, 43, 45
; DO_IT Clear Delete + -
; F2 F8 DEL
ENDWAIT
ENDPROC; Edit_Mode_Wait
; main body of procedure follows
Fld_Prompt["Date"] = " Date of transaction"
Fld_Prompt["File_No"] = " F1 to select file no. from file cabinet"
Fld_Prompt["Empl_Num"] = " F1 to select employee for this transaction"
Fld_Prompt["T_Code"] = " F1 to select code describing transaction"
Fld_Prompt["Acnt_No"] = " Account number for this entry"
Fld_Prompt["Amount"] = " Dollar amount of this transaction"
Fld_Prompt["Billed"] = " Y if transaction has been billed, N if not"
Fld_Prompt["Note"] = " Notation to help describe this entry"
Answer_Menu = "Deposit_Answer_Menu"
ECHO OFF
VIEW M_Tbl
Deposit_Table_Menu()
WINDOW MOVE GETWINDOW() TO -100, -100
PICKFORM F_Num
WINDOW HANDLE CURRENT TO Form_Win
DYNARRAY Win_Atts[]
Win_Atts["ORIGINROW"] = R
Win_Atts["ORIGINCOL"] = C
Win_Atts["CANMOVE"] = False
Win_Atts["CANRESIZE"] = False
Win_Atts["CANCLOSE"] = False
WINDOW SETATTRIBUTES Form_Win FROM Win_Atts
ECHO NORMAL
KEYENABLE -31
if (SYSMODE() = "Main") then
Main_Mode_Wait()
else Edit_Mode_Wait()
endif
KEYDISABLE -31
CLEARSPEEDBAR
MESSAGE ""
PROMPT ""
ENDPROC
WRITELIB Off_Lib Deposit_Table_Wait
RELEASE PROCS ALL

1040
old-database/FILCABNT.SC Executable file
View File

File diff suppressed because it is too large Load Diff

BIN
old-database/FILCABNT.SC2 Executable file
View File

Binary file not shown.

597
old-database/FORM_MGR.SC Executable file
View File

@@ -0,0 +1,597 @@
MESSAGE "Writing forms procedures to library..."
PROC Select_Forms()
; read list of form files on disk, match with descriptions in form table
; and place info in dialog box for user to select forms
PRIVATE Form_Table, Main_Drv, New_Form_Dir,
File_1, File_2, Form_Array, Form_Description, Button, Element
PROC Get_Form_Info(Key)
PRIVATE Form_Array
GETRECORD Form_Table UPPER(Key) TO Form_Array
if RetVal then
Key = Form_Array["Memo"]
else Key = "This file not listed in table of form names!"
endif
RETURN Key
ENDPROC; Get_Form_Info
PROC Process_Save_As_Dialog(TriggerType, TagValue, EventValue, ElementValue)
PRIVATE FileInfo
if (TriggerType = "SELECT") AND (TagValue = "Pick_Tag") then
PARSEFILENAME Pick_File TO FileInfo
File_Name = UPPER(FileInfo["FILE"])
REFRESHCONTROL "Accept_Tag"
RETURN TRUE
endif; SELECT
if (TriggerType = "ACCEPT") then
if (File_Name = "") then
MESSAGE "Error! File name cannot be blank!"
RETURN FALSE
else Text_File = PRIVDIR() + File_Name + ".MRG"
if ISFILE(Text_File) then
if Response_Is_Yes("Warning: Duplicate File Name!", "File exists, replace?") then
RETURN TRUE ; replace file
else RETURN FALSE ; do not replace file
endif
else RETURN TRUE ; file does not already exist
endif
endif
endif
RETURN TRUE
ENDPROC; Process_Save_As_Dialog
PROC Save_As_Dialog(File_Name)
PRIVATE Pick_File, Button_Val
SHOWDIALOG "Save Merge Configuration"
PROC "Process_Save_As_Dialog"
TRIGGER "SELECT", "ACCEPT"
@4,20 HEIGHT 16 WIDTH 40
@1,3 ?? "Save File As:"
ACCEPT @1,20
WIDTH 11 "A8"
PICTURE "*!"
TAG "Accept_Tag"
TO File_Name
PICKFILE @3,3 HEIGHT 8 WIDTH 32
COLUMNS 2
PRIVDIR() + "*.MRG"
TAG "Pick_Tag"
TO Pick_File
PUSHBUTTON @12,5 WIDTH 12
"~Y~es"
OK
DEFAULT
VALUE "OK"
TAG "OK_Button"
TO Button_Val
PUSHBUTTON @12,22 WIDTH 12
"~N~o"
CANCEL
VALUE "Cancel"
TAG "Cancel_Button"
TO Button_Val
ENDDIALOG
RETURN RetVal
ENDPROC; Save_As_Dialog
PROC Process_Dialog(TriggerType, TagValue, EventValue, ElementValue)
PRIVATE New_Dir, Text_File, Ch, L, Continue
if (TriggerType = "OPEN") then
SELECTCONTROL "Available_Tag"
Form_Description = Get_Form_Info(File_1)
REFRESHCONTROL "Description_Tag"
RETURN TRUE
endif; OPEN
if (TriggerType = "ARRIVE") then
RESYNCDIALOG
if (TagValue = "Available_Tag") then
Form_Description = Get_Form_Info(File_1)
else if (TagValue = "Selected_Tag") then
Form_Description = Get_Form_Info(File_2)
endif
endif
REFRESHCONTROL "Description_Tag"
RETURN TRUE
endif; ARRIVE
if (TriggerType = "UPDATE") then
if (TagValue = "Available_Tag") OR (TagValue = "Selected_Tag") then
Form_Description = Get_Form_Info(EventValue)
REFRESHCONTROL "Description_Tag"
RETURN TRUE
endif
; if user selects new subdirectory, verify then load file list
if (TagValue = "Directory_Tag") then
New_Dir = EventValue
if NOT MATCH(New_Dir, "..\\") then
New_Dir = New_Dir + "\\"
endif
if (New_Dir = Form_Dir) then
RETURN TRUE
endif
if (DIREXISTS(New_Dir) = 1) then ; change directory string
Form_Dir = New_Dir
New_Form_Dir = Form_Dir
File_1 = ""
File_2 = ""
FOREACH Element IN Form_Array
RELEASE VARS Form_Array[Element]
ENDFOREACH
REFRESHCONTROL "Available_Tag"
REFRESHCONTROL "Selected_Tag"
REFRESHCONTROL "Description_Tag"
RETURN TRUE
else BEEP
MESSAGE "Invalid subdirectory. Press any key to continue."
Ch = GETCHAR()
RETURN FALSE
endif
endif; Directory_Tag
endif; UPDATE
if (TriggerType = "SELECT") then
if (TagValue = "Available_Tag") then
if NOT ISFILE(Form_Dir + File_1) then
Form_Dir = SUBSTR(Main_Drv,1,2) + RELATIVEFILENAME(Form_Dir + File_1)
New_Form_Dir = Form_Dir
File_1 = ""
File_2 = ""
FOREACH Element IN Form_Array
RELEASE VARS Form_Array[Element]
ENDFOREACH
REFRESHCONTROL "Available_Tag"
REFRESHCONTROL "Selected_Tag"
REFRESHCONTROL "Description_Tag"
REFRESHCONTROL "Directory_Tag"
RETURN TRUE
else Form_Array[File_1] = File_1
REFRESHCONTROL "Selected_Tag"
endif
else if (TagValue = "Selected_Tag") then
RELEASE VARS Form_Array[File_2]
REFRESHCONTROL "Selected_Tag"
Form_Description = Get_Form_Info(File_2)
REFRESHCONTROL "Description_Tag"
endif
endif
RETURN TRUE
endif; SELECT
if (TriggerType = "ACCEPT") then
if (TagValue = "Save") OR (TagValue = "Run") then
if (DYNARRAYSIZE(Form_Array) <= 0) then
BEEP
SELECTCONTROL "Available_Tag"
MESSAGE("No form(s) selected. Press any key to continue.")
Ch = GETCHAR()
RETURN FALSE
endif
; if (TagValue = "Save") then
; if (USERNAME() <> "") then
; L = LEN(USERNAME())
; if (L > 8) then
; L = 8
; endif
; Text_File = SUBSTR(USERNAME(), 1, L)
; else Text_File = "ASSEMBLE"
; endif
; if ISFILE(PRIVDIR() + Text_File + ".MRG") then
; Text_File = "" ; if file exists, set name to blank
; endif
; Continue = Save_As_Dialog(Text_File)
; else Continue = True
; Text_File = PRIVDIR() + "$$$$$$$$.MRG"
; endif
Text_File = "R:\\PRIVATE\\$$$$$$$$.MRG"
Continue = True
if Continue then
FILEWRITE Text_File FROM Main_Dir + "\n" ; data subdirectory
PRINT FILE Text_File Main_Drv, "DOCUMENT\\WPDOCS\\DOCS\\", "\n" ; target subdirectory
PRINT FILE Text_File UPPER(Main_Table), "\n" ; rolodex, files, etc.
MOVETO Subset_Table
FORMKEY ; show table form view
CTRLHOME
TAB
SCAN
PRINT FILE Text_File FIELDSTR(), "\n"
ENDSCAN
FORMKEY ; return to form view
PRINT FILE Text_File "FORMS\n" ; print full file name for each selected form
if NOT MATCH(Form_Dir, "..\\") then
Form_Dir = Form_Dir + "\\"
endif
FOREACH Element IN Form_Array
PRINT FILE Text_File Form_Dir, Form_Array[Element], "\n"
ENDFOREACH
if (TagValue = "Run") then
MESSAGE "Executing document assembly program..."
RUN BIG "R:\\PRIVATE\\GO.BAT" ; run external dos merge program
MESSAGE ""
else MESSAGE "Configuration file saved successfully."
endif
endif;
RETURN FALSE ; return to dialog box
endif; Save Or Run
if (TagValue = "Tag_All") then
; method to select all available form files
RETURN FALSE
else if (TagValue = "UnTag_All") then
FOREACH Element IN Form_Array
RELEASE VARS Form_Array[Element]
ENDFOREACH
REFRESHCONTROL "Selected_Tag"
REFRESHCONTROL "Description_Tag"
RETURN FALSE
else RETURN TRUE
endif
endif; Tag_All
endif; ACCEPT
RETURN TRUE
ENDPROC; Process_Dialog
; Main procedure begins here
MOUSE SHOW
if (DIREXISTS(Form_Dir) <> 1) then ; does initial subdir exist
Form_Dir = Main_Dir
endif
New_Form_Dir = Form_Dir
Main_Drv = SUBSTR(Main_Dir, 1, 3)
Form_Table = Main_Dir + "FORMS\\FORM_LST"
File_1 = ""
File_2 = ""
DYNARRAY Form_Array[]
ECHO OFF
SHOWDIALOG "Select Forms To Merge With Data"
PROC "Process_Dialog"
TRIGGER "UPDATE", "ARRIVE", "SELECT", "OPEN", "ACCEPT"
@2, 4 HEIGHT 21 WIDTH 71
LABEL @1,1
"~C~urrent Directory:"
FOR "Directory_Tag"
ACCEPT @2,2 WIDTH 65 "A80" PICTURE "*!"
TAG "Directory_Tag"
TO Form_Dir
LABEL @4,1
"~A~vailable Forms: (Space = Tag)"
FOR "Available_Tag"
PICKFILE @5,2 HEIGHT 10 WIDTH 32
COLUMNS 2
Form_Dir
SHOWDIRS
TAG "Available_Tag"
TO File_1
LABEL @16,1
"~F~orm Description:"
FOR "Description_Tag"
ACCEPT @17,2 WIDTH 65
"A150"
TAG "Description_Tag"
TO Form_Description
LABEL @4,36
"~S~elected Forms: (Space = Untag)"
FOR "Selected_Tag"
PICKDYNARRAY @5,37 HEIGHT 10 WIDTH 15
Form_Array
TAG "Selected_Tag"
TO File_2
PUSHBUTTON @6,55 WIDTH 12
"~R~un"
OK
DEFAULT
VALUE ""
TAG "Run"
TO Button
PUSHBUTTON @8,55 WIDTH 12
"~S~ave"
OK
VALUE ""
TAG "Save"
TO Button
PUSHBUTTON @10,55 WIDTH 12
"~T~ag All"
OK
VALUE "ACCEPT"
TAG "Tag_All"
TO Button
PUSHBUTTON @12,55 WIDTH 12
"~U~nTag All"
OK
VALUE "ACCEPT"
TAG "UnTag_All"
TO Button
PUSHBUTTON @14,55 WIDTH 12
"~Q~uit"
CANCEL
VALUE ""
TAG "Cancel"
TO Button
ENDDIALOG
Form_Dir = New_Form_Dir ; use current subdir as default next time
MOUSE HIDE
MOVETO Subset_Table
ENDPROC
WRITELIB Off_Lib Select_Forms
;=============================================================================
PROC Form_Wait()
PRIVATE Fld_Prompt, Answer_Menu
PROC Process_Dialog(TriggerType, TagValue, EventValue, ElementValue)
if (TriggerType = "SELECT") then
if (TagValue = "IndexArrayTag") then
Search_Words[I_Word] = I_Word
else if (TagValue = "SearchArrayTag") then
RELEASE VARS Search_Words[S_Word]
endif
endif
REFRESHCONTROL "SearchArrayTag"
endif
RETURN TRUE
ENDPROC; Process_Dialog
PROC Ask_Form()
; user selects a subset of forms table based on search criteria
PRIVATE Index_Words, Search_Words, I_Word, S_Word, Name, Description, Status, Element
FORMKEY ; switch to table view
SHOWPULLDOWN ; hide main menu
ENDMENU
CLEARSPEEDBAR ; clear form speedbar
PROMPT "Press Search to find matching forms; ESC or Cancel to quit."
MOUSE SHOW
DYNARRAY Index_Words[]
DYNARRAY Search_Words[]
Name = ""
Description = ""
Status = ""
ECHO OFF
; load all index words into a dynamic array
VIEW "Inx_Lkup"
SCAN
Index_Words[STRVAL([Keyword])] = [Keyword]
ENDSCAN
CLEARIMAGE
SHOWDIALOG "Form Selection Criteria"
PROC "Process_Dialog"
TRIGGER "SELECT", "ARRIVE"
@2, 6 HEIGHT 21 WIDTH 68
@1, 2 ?? "Name"
ACCEPT @1,15
WIDTH 48 "A80" PICTURE "*!"
TAG "Name_Tag"
TO Name
@2, 2 ?? "Description"
ACCEPT @2,15
WIDTH 48 "A80"
TAG "Desc_Tag"
TO Description
@3, 2 ?? "Status"
ACCEPT @3,15
WIDTH 15 "A40"
TAG "Status_Tag"
TO Status
LABEL @5,2
"~I~ndex List: (Space = Add)"
FOR "IndexArrayTag"
PICKDYNARRAY @6,2 HEIGHT 10 WIDTH 28
Index_Words
TAG "IndexArrayTag"
TO I_Word
LABEL @5,35
"~S~earch For: (Space = Delete)"
FOR "SearchArrayTag"
PICKDYNARRAY @6,35 HEIGHT 10 WIDTH 28
Search_Words
TAG "SearchArrayTag"
TO S_Word
PUSHBUTTON @17,20 WIDTH 10
"~S~earch"
OK
DEFAULT
VALUE ""
TAG "OK"
TO Button
PUSHBUTTON @17,40 WIDTH 10
"~C~ancel"
CANCEL
VALUE ""
TAG "Cancel"
TO Button
ENDDIALOG
PROMPT ""
if (RetVal = True) then
MESSAGE "Searching..."
ECHO OFF
{Ask} {Form_lst} Check Tab Example "link"
if NOT ISBLANK(Name) then
TYPEIN (", " + Name)
endif
TAB
if NOT ISBLANK(Description) then
TYPEIN Description
endif
TAB
if NOT ISBLANK(Status) then
TYPEIN Status
endif
{Ask} {Form_inx}
FOREACH Element IN Search_Words
if NOT ISBLANK(Search_Words[Element]) then
TAB
EXAMPLE "link"
TAB
TYPEIN Search_Words[Element]
RIGHT
endif
ENDFOREACH
DO_IT!
Subset_Table = PRIVDIR() + "SUBSET"
RENAME TABLE() Subset_Table
MOVETO "Form_lst(Q)" CLEARIMAGE
MOVETO "Form_inx(Q)" CLEARIMAGE
MOVETO Subset_Table
if ISEMPTY(Subset_Table) then
CLEARIMAGE
No_Matches_Found()
else ; copy form and display on screen
{Tools} {Copy} {JustFamily} {Form_lst} TYPEIN Subset_Table ENTER {Replace}
View_Answer_Table(Subset_Table, 1, 3)
DOWNIMAGE
IMAGERIGHTS READONLY
UPIMAGE
Form_Answer_Wait()
endif
endif
FORMKEY ; return to form view
MOUSE HIDE
ENDPROC; Ask_Form
PROC Form_Answer_Menu()
SHOWPULLDOWN
"Modify" : "Toggle between edit and main mode" : "Modify"
SUBMENU
"Edit Mode - F9" : "Allow data to be edited, deleted, etc." : "Edit\Mode",
"Main Mode - F2" : "Discontinue editing" : "Main\Mode"
ENDSUBMENU,
"Reports" : "Choose report to generate" : "Reports"
SUBMENU
"Form List" : "Print list of matching forms" : "Form_List"
ENDSUBMENU,
"Return" : "Return to previous menu" : ""
SUBMENU
"No " : "Continue working with selected data" : "Return\No",
"Yes - F8" : "Return to complete data set" : "Return\Yes"
ENDSUBMENU
ENDMENU
if (SYSMODE() = "Main") then
MENUDISABLE "Main\Mode"
else MENUDISABLE "Edit\Mode"
MENUDISABLE "Reports"
endif
Form_Speedbar()
ENDPROC; Form_Answer_Menu
PROC Form_Answer_Wait_Proc(TriggerType, EventInfo, CycleNumber)
if (EventInfo["TYPE"] = "MESSAGE") And
(EventInfo["MESSAGE"] = "MENUSELECT") And
(EventInfo["MENUTAG"] = "Form_List") then
SHOWPULLDOWN
ENDMENU
CLEARSPEEDBAR
MESSAGE "One moment please..."
ECHO OFF
Print_Report(Subset_Table, "1", "")
EXECPROC Answer_Menu
RETURN 1
else RETURN Answer_Table_Wait_Proc(TriggerType, EventInfo, CycleNumber)
endif
ENDPROC; Form_Answer_Wait_Proc
PROC Form_Answer_Wait()
Form_Answer_Menu()
Sound_Off()
ECHO NORMAL
Message_Box("Search Completed", "Matching Form Entries: " + STRVAL(NRECORDS(Subset_Table)))
WAIT WORKSPACE
PROC "Form_Answer_Wait_Proc"
MESSAGE "MENUSELECT"
TRIGGER "ARRIVEFIELD"
KEY -60, -66, -67, -83, -50
; DO_IT Clear Edit Delete Memo
; F2 F8 F9 DEL Alt-M
ENDWAIT
CLEARSPEEDBAR
MESSAGE ""
ENDPROC; Form_Answer_Wait
PROC Form_Wait_Proc(TriggerType, EventInfo, CycleNumber)
PRIVATE Key_Code, Menu_Pick
if (TriggerType = "ARRIVEFIELD") then
PROMPT Fld_Prompt[FIELD()]
RETURN 1
endif
if (EventInfo["TYPE"] = "KEY") then
Key_Code = EventInfo["KEYCODE"]
SWITCH
; F9 - COEDIT
CASE (Key_Code = -67) : RETURN Main_Table_Edit()
; F2 - DO_IT!
CASE (Key_Code = -60) : if ISEMPTY(Main_Table) then
RETURN Main_Table_Clear()
else RETURN Main_Table_End_Edit()
endif
; F8 - CLEAR
CASE (Key_Code = -66) : RETURN Main_Table_Clear()
; Alt-M - Memo
CASE (Key_Code = -50) : Display_Memo(Main_Table)
Main_Table_Menu()
Form_Speedbar()
RETURN 1
; DELETE
CASE (Key_Code = -83) : if (SYSMODE() = "CoEdit") then
RETURN Display_Delete_Box()
else RETURN 1
endif
OTHERWISE : SOUND 400 100 RETURN 1
ENDSWITCH
endif
if (EventInfo["MESSAGE"] = "MENUSELECT") then
Menu_Pick = EventInfo["MENUTAG"]
SWITCH
CASE (Menu_Pick = "Edit\Mode") : RETURN Main_Table_Edit()
CASE (Menu_Pick = "Main\Mode") : if ISEMPTY(Main_Table) then
RETURN Main_Table_Clear()
else RETURN Main_Table_End_Edit()
endif
CASE (Menu_Pick = "Ask") : Ask_Form()
Main_Table_Menu()
Form_Speedbar()
RETURN 1
CASE (Menu_Pick = "Close\Yes") : RETURN Main_Table_Clear()
CASE (Menu_Pick = "Close\No") : RETURN 1
OTHERWISE : SOUND 400 100 RETURN 1
ENDSWITCH
endif
SOUND 400 100 RETURN 1 ; safety valve
ENDPROC; Form_Wait_Proc
PROC Form_Speedbar()
CLEARSPEEDBAR
SPEEDBAR "~F10~ Menu":-68, "~Alt-M~ Memo":-50
PROMPT Fld_Prompt[FIELD()]
ENDPROC; Form_Speedbar
; MAIN PROCEDURE BEGINS HERE
ECHO OFF
SETDIR "FORMS"
Answer_Menu = "Form_Answer_Menu"
DYNARRAY Fld_Prompt[]
Fld_Prompt["Name"] = "Unique form name (required)."
Fld_Prompt["Memo"] = "Description of form and its usage."
Fld_Prompt["Status"] = "Status code indicating merge availability."
Fld_Prompt["Keyword"] = "Indexed keywords for form. F1 for lookup help."
Main_Table_View(Main_Table, 1, 3)
Form_Speedbar()
ECHO NORMAL
WAIT WORKSPACE
PROC "Form_Wait_Proc"
MESSAGE "MENUSELECT"
TRIGGER "ARRIVEFIELD"
KEY -60, -66, -67, -83, -50
; DO_IT Clear Edit Delete Alt-M
; F2 F8 F9 DEL Memo
ENDWAIT
CLEARSPEEDBAR
PROMPT ""
MESSAGE ""
ECHO OFF
if ISTABLE(Subset_Table) then
DELETE Subset_Table
endif
SETDIR Main_Dir
ENDPROC
WRITELIB Off_Lib Form_Wait
RELEASE PROCS ALL

BIN
old-database/FORM_MGR.SC2 Executable file
View File

Binary file not shown.

262
old-database/GENERATE.SC Executable file
View File

@@ -0,0 +1,262 @@
MESSAGE "Generating Office Library..."
Off_Lib = "OFFICE"
CREATELIB Off_Lib SIZE 128
PROC Change_Date(Sign)
if (SYSMODE() = "CoEdit") AND (FIELDTYPE() = "D") then
if ISBLANK([]) then
[] = TODAY()
else if (Sign = 43) then
[] = [] + 1
else [] = [] - 1
endif
endif
else RETURN 0
endif
RETURN 1
ENDPROC
WRITELIB Off_Lib Change_Date
PROC Main_Table_Edit()
; allowing editing of current table image, do not break wait
if (SYSMODE() = "Main") then
COEDITKEY
MENUDISABLE "Edit\Mode"
MENUDISABLE "Ask"
MENUENABLE "Main\Mode"
endif
RETURN 1
ENDPROC
WRITELIB Off_Lib Main_Table_Edit
PROC Main_Table_End_Edit()
; exit edit mode, if possible, do not break out of wait cycle
if (HELPMODE() = "LookupHelp") then ; if user was 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 ; if in field view, do not exit wait loop
DO_IT!
RETURN 1
endif
DO_IT!
if (SYSMODE() = "Main") then ; record posted successfully
MENUDISABLE "Main\Mode"
MENUENABLE "Edit\Mode"
MENUENABLE "Ask"
else ECHO NORMAL ; key violation exists
DO_IT!
endif
RETURN 1
ENDPROC
WRITELIB Off_Lib Main_Table_End_Edit
PROC Main_Table_Clear()
; exit edit mode by calling main mode, clear workspace and exit wait
if (SYSMODE() = "CoEdit") then
Main_Table_End_Edit()
endif
if (SYSMODE() = "Main") then
ECHO OFF
CLEARALL
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 Main_Table_Clear
PROC Display_Memo(Tbl)
; move to proper table image, then memo field, enter field view and pop up
; memo window - if available, wait until F2 is pressed
if ISFIELDVIEW() then ; if in field view, do not exit wait loop
DO_IT!
endif
if NOT ISVALID() then ; if in coedit and field data is not valid,
RETURN 0 ; do not exit wait
endif
MOVETO Tbl
MOVETO FIELD "Memo"
SHOWPULLDOWN
ENDMENU
CLEARSPEEDBAR
if (Field() = "Memo") then
ECHO OFF
FIELDVIEW
WINDOW HANDLE CURRENT TO Memo_Win
DYNARRAY Atts[]
DYNARRAY Colors[]
Colors["1"] = 31
Atts["ORIGINROW"] = 13
Atts["ORIGINCOL"] = 0
Atts["CANMOVE"] = False
Atts["CANRESIZE"] = False
Atts["CANCLOSE"] = False
Atts["HEIGHT"] = 11
Atts["WIDTH"] = 80
Atts["HASSHADOW"] = FALSE
Atts["TITLE"] = " Memo "
WINDOW SETATTRIBUTES Memo_Win FROM Atts
WINDOW SETCOLORS Memo_Win FROM Colors
PROMPT " Press F2 when finished."
ECHO NORMAL
WAIT FIELD
UNTIL "F2"
DO_IT!
else MESSAGE "No memo field is available in this context."
endif
ENDPROC
WRITELIB Off_Lib Display_Memo
PROC Main_Table_Menu()
SHOWPULLDOWN
"Modify" : "Toggle between edit and main mode" : "Modify"
SUBMENU
"Edit Mode - F9" : "Allow data to be edited, deleted, etc." : "Edit\Mode",
"Main Mode - F2" : "Discontinue editing" : "Main\Mode"
ENDSUBMENU,
"Ask" : "Select data to report on" : "Ask",
"Close" : "Return to main menu when finished" : ""
SUBMENU
"No " : "Continue working with this table" : "Close\No",
"Yes - F8" : "Return to main menu" : "Close\Yes"
ENDSUBMENU
ENDMENU
if ISEMPTY(TABLE()) then
Main_Table_Edit()
else if (SYSMODE() = "Main") then
MENUDISABLE "Main\Mode"
else MENUDISABLE "Edit\Mode"
MENUDISABLE "Ask"
endif
endif
ENDPROC
WRITELIB Off_Lib Main_Table_Menu
PROC Main_Table_View(Tbl, R, C)
; place table on workspace in form view
ECHO OFF
VIEW Tbl
WINDOW MOVE GETWINDOW() TO -100, -100
Main_Table_Menu()
PICKFORM "1"
WINDOW HANDLE CURRENT TO Form_Win
DYNARRAY Win_Atts[]
Win_Atts["ORIGINROW"] = R
Win_Atts["ORIGINCOL"] = C
Win_Atts["CANMOVE"] = False
Win_Atts["CANRESIZE"] = False
Win_Atts["CANCLOSE"] = False
WINDOW SETATTRIBUTES Form_Win FROM Win_Atts
ENDPROC
WRITELIB Off_lib Main_Table_View
PROC View_Answer_Table(Tbl, R, C)
WINDOW MOVE GETWINDOW() TO -100, -100
PICKFORM "1"
WINDOW HANDLE CURRENT TO Form_Win
DYNARRAY Win_Atts[]
Win_Atts["TITLE"] = "RECORDS MATCHING SELECTION CRITERIA"
Win_Atts["ORIGINROW"] = R
Win_Atts["ORIGINCOL"] = C
Win_Atts["CANMOVE"] = False
Win_Atts["CANRESIZE"] = False
Win_Atts["CANCLOSE"] = False
WINDOW SETATTRIBUTES Form_Win FROM Win_Atts
ENDPROC
WRITELIB Off_Lib View_Answer_Table
PROC Answer_Table_Wait_Proc(TriggerType, EventInfo, CycleNumber)
PRIVATE Key_Code, Menu_Pick
if (TriggerType = "ARRIVEFIELD") then
PROMPT Fld_Prompt[FIELD()]
RETURN 1
endif
if (EventInfo["TYPE"] = "KEY") then ; check for hot keys
Key_Code = EventInfo["KEYCODE"]
SWITCH
; F9 - COEDIT
CASE (Key_Code = -67) : RETURN Edit_Mode()
; F2 - DO_IT!
CASE (Key_Code = -60) : if ISEMPTY(Subset_Table) then
RETURN Clear_Table()
else RETURN Main_Mode()
endif
; F8 - CLEAR
CASE (Key_Code = -66) : RETURN Clear_Table()
; DELETE
CASE (Key_Code = -83) : if (SYSMODE() = "CoEdit") then
RETURN Display_Delete_Box()
else RETURN 1
endif
; Alt-M - Memo
CASE (Key_Code = -50) : Display_Memo(Subset_Table)
EXECPROC Answer_Menu
RETURN 1
; Alt-B - Summarize Account Balances
CASE (Key_Code = -48) : Summarize_Accounts(Subset_Table, IMAGENO())
EXECPROC Answer_Menu
RETURN 1
CASE (Key_Code = 43) : RETURN Change_Date(43)
CASE (Key_Code = 45) : RETURN Change_Date(45)
OTHERWISE : SOUND 400 100 RETURN 1
ENDSWITCH
endif; if key was pressed
if (EventInfo["MESSAGE"] = "MENUSELECT") then ; now menu selections
Menu_Pick = EventInfo["MENUTAG"]
SWITCH
CASE (Menu_Pick = "Edit\Mode") : RETURN Edit_Mode()
CASE (Menu_Pick = "Main\Mode") : if ISEMPTY(Subset_Table) then
RETURN Clear_Table()
else RETURN Main_Mode()
endif
CASE (Menu_Pick = "Assemble") : if (SYSMODE() = "CoEdit") then
MESSAGE("You must exit edit mode.")
else Select_Forms()
endif
RETURN 1
CASE (Menu_Pick = "Return\Yes") : RETURN Clear_Table()
CASE (Menu_Pick = "Return\No") : RETURN 1
OTHERWISE : SOUND 400 100 RETURN 1
ENDSWITCH
endif
SOUND 400 100 RETURN 1
ENDPROC
WRITELIB Off_Lib Answer_Table_Wait_Proc
RELEASE PROCS ALL
PLAY "Setup"
PLAY "Rolodex"
PLAY "Filcabnt"
PLAY "Ledger"
PLAY "Utility"
PLAY "Pension"
PLAY "Qdro"
PLAY "Form_Mgr"
; do not PLAY procedures that are no longer used
;PLAY "Calendar"
;PLAY "Timecard"
;PLAY "Trust"
MESSAGE "All procedures successfully written to office library."
SLEEP 2000
MESSAGE ""

BIN
old-database/GENERATE.SC2 Executable file
View File

Binary file not shown.

397
old-database/LEDGER.SC Executable file
View File

@@ -0,0 +1,397 @@
MESSAGE "Writing ledger procedures to library..."
PROC Tally_Ledger()
; starts in ledger table, totals, ends in file cabinet
PRIVATE F_No,
T_Bal, Hours, H_Bal, F_Bal, D_Bal, C_Bal,
T_Bal_P, Hours_P, H_Bal_P, F_Bal_P, D_Bal_P, C_Bal_P
; initialize variables to zero
T_Bal = 0.0 T_Bal_P = 0.0
Hours = 0.0 Hours_P = 0.0
H_Bal = 0.0 H_Bal_P = 0.0
F_Bal = 0.0 F_Bal_P = 0.0
D_Bal = 0.0 D_Bal_P = 0.0
C_Bal = 0.0 C_Bal_P = 0.0
if RECORDSTATUS("New") then ; no records, delete this new record
DEL
else F_No = [File_No]
MESSAGE "Updating " + [File_No] + " account totals..."
SCAN ; total accounts
if ([Billed] = "Y") then
; include transaction in previously billed totals
SWITCH
CASE ([T_Type] = "1") : T_Bal_P = T_Bal_P + [Amount]
CASE ([T_Type] = "2") : Hours_P = Hours_P + [Quantity]
H_Bal_P = H_Bal_P + [Amount]
CASE ([T_Type] = "3") : F_Bal_P = F_Bal_P + [Amount]
CASE ([T_Type] = "4") : D_Bal_P = D_Bal_P + [Amount]
CASE ([T_Type] = "5") : C_Bal_P = C_Bal_P + [Amount]
ENDSWITCH
else ; include transaction in unbilled totals
SWITCH
CASE ([T_Type] = "1") : T_Bal = T_Bal + [Amount]
CASE ([T_Type] = "2") : Hours = Hours + [Quantity]
H_Bal = H_Bal + [Amount]
CASE ([T_Type] = "3") : F_Bal = F_Bal + [Amount]
CASE ([T_Type] = "4") : D_Bal = D_Bal + [Amount]
CASE ([T_Type] = "5") : C_Bal = C_Bal + [Amount]
ENDSWITCH
endif
ENDSCAN
endif
MOVETO M_Tbl ; files table to update totals
; == previously billed balances ==
[Trust_Bal_P] = T_Bal_P
[Hours_P] = Hours_P
[Hourly_Fees_P] = H_Bal_P
[Flat_Fees_P] = F_Bal_P
[Disbursements_P] = D_Bal_P
[Credit_Bal_P] = C_Bal_P
[Total_Charges_P] = H_Bal_P + F_Bal_P + D_Bal_P
[Amount_Owing_P] = Round([Total_Charges_P] - [Credit_Bal_P], 2)
; == current total balances ==
[Trust_Bal] = T_Bal_P + T_Bal
[Hours] = Hours_P + Hours
[Hourly_Fees] = H_Bal_P + H_Bal
[Flat_Fees] = F_Bal_P + F_Bal
[Disbursements] = D_Bal_P + D_Bal
[Credit_Bal] = C_Bal_P + C_Bal
[Total_Charges] = [Hourly_Fees] + [Flat_Fees] + [Disbursements]
[Amount_Owing] = [Total_Charges] - [Credit_Bal]
if ([Amount_Owing] > 0) And ([Trust_Bal] > 0) then
if ([Trust_Bal] >= [Amount_Owing]) then
[Transferable] = [Amount_Owing]
else [Transferable] = [Trust_Bal]
endif
else [Transferable] = 0.0
endif
MESSAGE ""
ENDPROC
WRITELIB Off_Lib Tally_Ledger
PROC Tally_All(M_Tbl, D_Tbl)
if ISEMPTY(M_Tbl) then
RETURN 1
endif
MESSAGE "Updating file accounts..."
ECHO OFF
COEDIT M_Tbl
PICKFORM "1"
SCAN ; assign file numbers to dynamic array
MOVETO D_Tbl ; move to ledger table
Tally_Ledger() ; total accounts for this file
ENDSCAN
DO_IT!
CLEARALL; remove file cabinet images
ECHO NORMAL
Message_Box("Updating Balances", "All accounts have been updated.")
ENDPROC
WRITELIB Off_Lib Tally_All
PROC Update_Accounts()
ECHO OFF
Tally_Ledger()
ENDPROC
WRITELIB Off_Lib Update_Accounts
PROC Total_Row()
PRIVATE New_Amount
if RECORDSTATUS("New") OR RECORDSTATUS("Modified") then
if NOT ISBLANK([Quantity]) AND NOT ISBLANK([Rate]) then
New_Amount = Round([Quantity]*[Rate], 2)
if (New_Amount <> [Amount]) then
[Amount] = New_Amount
endif
endif
endif
ENDPROC
WRITELIB Off_Lib Total_Row
; ************* Local Procedures *****************
PROC Ledger_Table_Wait(New_Row, Empl_Code, Hourly_Rate)
PROC Arr_Field()
File_Cabinet_Speedbar()
ENDPROC; Arr_Field
PROC Arr_Row()
if RECORDSTATUS("New") AND NOT RECORDSTATUS("Modified") then
[Billed] = "N"
endif
ENDPROC; Arr_Row
PROC Dep_Field()
if NOT ISVALID() then
Message_Box("Invalid Field Entry", "The data in this field is invalid.")
RETURN 1
endif
SWITCH
CASE FIELD() = "Date" :
if ISBLANK([]) then
[Date] = TODAY()
endif
CASE FIELD() = "T_Code" :
if ISBLANK([]) then
[T_Type_L] = ""
endif
ECHO OFF
TAB
REVERSETAB
ECHO NORMAL
CASE FIELD() = "Empl_Num" :
if ISBLANK([]) then
[Empl_Num] = Empl_Code
endif
CASE FIELD() = "Quantity" :
Total_Row()
CASE FIELD() = "Rate" :
if ISBLANK([Rate]) AND ([T_Type] = "2") then
if ([Empl_Num] = Empl_Code) then
[Rate] = Hourly_Rate
else if NOT ISBLANK([Empl_Num]) then
GETRECORD "Employee" [Empl_Num] TO DYNARRAY A
if RETVAL then
[Rate] = A["Rate_Per_Hour"]
endif
endif
endif
endif
Total_Row()
CASE FIELD() = "Amount" :
Total_Row()
CASE FIELD() = "Billed" :
if ISBLANK([]) then
[Billed] = "N"
endif
OTHERWISE :
ENDSWITCH
RETURN 0
ENDPROC; Dep_Field
PROC Dep_Row()
; depart row if record is new & blank
if RECORDSTATUS("New") AND NOT RECORDSTATUS("Modified") then
RETURN 0
endif
if ISBLANK([Date]) then
Message_Box("Incomplete Entry", "This transaction requires a date.")
MOVETO [Date]
RETURN 1
endif
if ISBLANK([T_Code]) then
Message_Box("Incomplete Entry", "This transaction requires a transaction code.")
MOVETO [T_Code]
RETURN 1
endif
if ISBLANK([Empl_Num]) then
Message_Box("Incomplete Entry", "This transaction requires an employee number.")
MOVETO [Empl_Num]
RETURN 1
endif
if ISBLANK([Amount]) then
Message_Box("Incomplete Entry", "This transaction requires an hours/dollar amount entry.")
MOVETO [Amount]
RETURN 1
endif
if ISBLANK([Billed]) then
Message_Box("Incomplete Entry", "Specify whether transaction has been billed (Y/N).")
MOVETO [Billed]
RETURN 1
endif
if ISFIELDVIEW() then
DO_IT!
endif
; repeat attempts to post record by changing item_no key until posted
if RECORDSTATUS("New") OR RECORDSTATUS("Modified") then
ECHO OFF
WHILE TRUE
if ISBLANK([Item_No]) then
[Item_No] = 1
endif
POSTRECORD NOPOST LEAVELOCKED
if RetVal then
QUITLOOP
else [Item_No] = [Item_No] + 1
endif
ENDWHILE
ECHO NORMAL
endif
RETURN 0
ENDPROC; Depart_Row
PROC End_Edit(Clear_Table)
if ISFIELDVIEW() then
DO_IT!
RETURN 1
endif
if (Dep_Field() <> 0) then
RETURN 1
endif
if (Dep_Row() = 0) then ; record posted
Update_Accounts()
if Clear_Table then
Main_Table_Clear()
else Main_Table_End_Edit()
endif
if (SYSMODE() = "Main") then
RETURN 2
endif
endif
RETURN 1
ENDPROC; End_Edit
PROC Ledger_Table_Wait_Proc(TriggerType, EventInfo, CycleNumber)
PRIVATE Key_Code, Menu_Pick, Temp_Date, Rec_No, Row_No, I
if (TriggerType = "ARRIVEFIELD") then
Arr_Field()
RETURN 0
endif
if (TriggerType = "ARRIVEROW") then
Arr_Row()
RETURN 0
endif
if (TriggerType = "DEPARTFIELD") then
RETURN Dep_Field()
endif
if (TriggerType = "DEPARTROW") then
RETURN Dep_Row()
endif
if (EventInfo["TYPE"] = "KEY") then
Key_Code = EventInfo["KEYCODE"]
SWITCH
; DELETE
CASE (Key_Code = -83) :
if ISFIELDVIEW() then
RETURN 0
endif
if Response_Is_Yes("Confirm Deletion", "Are you sure you want to delete this entry?") then
if (NIMAGERECORDS() = 1) then
DEL
Update_Accounts()
RETURN 2 ; deletion of only record terminates ledger wait
else DEL
Arr_Row()
Arr_Field()
endif
endif
RETURN 1
; INSERT
CASE (Key_Code = -82) :
if (Dep_Field() <> 0) then
RETURN 1
endif
if (Dep_Row() = 0) then
MOVETO FIELD "Date"
if ATFIRST() then
Temp_Date = BLANKDATE()
else UP
Temp_Date = []
DOWN
endif
INS
[] = Temp_Date
Arr_Row()
Arr_Field()
endif
RETURN 1
; F2 - Do_It!
CASE (Key_Code = -60) : RETURN End_Edit(FALSE)
; F8 - CLEAR
CASE (Key_Code = -66) : RETURN End_Edit(TRUE)
; F3-UPIMAGE, F4-DOWNIMAGE
CASE (Key_Code = -61) OR (Key_Code = -62) :
if (Dep_Field() <> 0) then
RETURN 1
endif
if (Dep_Row() = 0) then ; record posted
Update_Accounts()
DOWNIMAGE ; move to ledger table
HOME ; go to first record
MOVETO M_Tbl ; move back to file cabinet
RETURN 2
else RETURN 1
endif
; ALT-B - Summarize Balances
CASE (Key_Code = -48) :
if (Dep_Field() <> 0) then
RETURN 1
endif
if (Dep_Row() = 0) then ; record posted
Rec_No = RECNO()
Row_No = ROWNO()
Update_Accounts()
Summarize_Accounts(M_Tbl, 1)
DOWNIMAGE ; move back to ledger table
HOME
FOR I FROM 1 TO Row_No-1
DOWN
ENDFOR
MOVETO RECORD Rec_No
REFRESH
endif
RETURN 1
; ALT-T - Start or stop time keeper
CASE (Key_Code = -20) :
if Timing then
Stop_Ticker()
else Start_Ticker()
endif
RETURN 1
; Alt-Y or Alt-N
CASE (Key_Code = -21) OR (Key_Code = -49) :
if ISFIELDVIEW() then
DO_IT!
endif
if (SYSMODE() <> "CoEdit") OR NOT ISVALID() then
RETURN 0
else if (Key_Code = -21) then
[Billed] = "Y"
else [Billed] = "N"
endif
endif
RETURN 1
; + or - to change current date
CASE (Key_Code = 43) OR (Key_Code = 45) :
RETURN Change_Date(Key_Code)
OTHERWISE : SOUND 400 100 RETURN 1
ENDSWITCH
RETURN 1
endif; key type
if (EventInfo["MESSAGE"] = "MENUSELECT") then
Menu_Pick = EventInfo["MENUTAG"]
SWITCH
CASE (Menu_Pick = "Main\Mode") : RETURN End_Edit(FALSE)
CASE (Menu_Pick = "Return\Yes") : RETURN End_Edit(TRUE)
CASE (Menu_Pick = "Return\No") : RETURN 1
OTHERWISE : SOUND 400 100 RETURN 1
ENDSWITCH
endif
SOUND 400 100 RETURN 1 ; safety valve, ignore all events not recognized
ENDPROC; Ledger_Table_Wait_Proc
; ********** MAIN PROCEDURE BEGINS HERE **********
if New_Row then
if (RecordStatus("New") = FALSE) then ; table is not empty
END ; open up new row
DOWN
endif
endif
MOVETO FIELD "Date"
Arr_Field()
Arr_Row()
ECHO NORMAL
WAIT WORKSPACE
PROC "Ledger_Table_Wait_Proc"
MESSAGE "MENUSELECT"
TRIGGER "ARRIVEFIELD", "DEPARTFIELD", "ARRIVEROW", "DEPARTROW"
KEY -60, -66, -48, -83, -82, -61, -62, -20, 43, 45, -49, -21
; DO_IT Clear Alt-B Del Ins UpI DnI Alt-T + -
; F2 F8 Sum Balances Del Ins F3 F4 Timer AltN,Y
ENDWAIT
CLEARSPEEDBAR
MESSAGE ""
ENDPROC
WRITELIB Off_Lib Ledger_Table_Wait
RELEASE PROCS ALL

BIN
old-database/LEDGER.SC2 Executable file
View File

Binary file not shown.

BIN
old-database/MAIN_RH.SC2 Executable file
View File

Binary file not shown.

155
old-database/Main_RH.SC Executable file
View File

@@ -0,0 +1,155 @@
; clear workspace, procedures, variables, etc.
ECHO OFF
RELEASE VARS ALL
RELEASE PROCS ALL
ALTSPACE {Desktop} {Empty}
MOUSE HIDE
SHOWPULLDOWN
ENDMENU
PROMPT ""
PROC Show_Main_Menu()
SHOWPULLDOWN
"Open" : "Select area to work in" : "Open"
SUBMENU
"Rolodex" : "Names, addresses and phone numbers of clients, etc." : "Rolodex",
"File Cabinet" : "Client file and billing information" : "Files",
"QDRO Screen" : "Enter/edit information for drafting QDROs" : "QDROs",
SEPARATOR,
"Plan Information" : "Summary of Retirement Plan Particulars" : "PlanInfo",
"Annuity Evaluator" : "Calculate present value of an annuity" : "Pensions",
"Deposit Book" : "Record bank deposits" : "Deposits"
ENDSUBMENU,
"Utilities" : "System utilities" : "Utilities"
SUBMENU
"Basic Data" : "Enter and modify basic data" : ""
SUBMENU
"Areas of Law" : "File relate to a specific area of law (e.g. divorce)" : "FileType",
"Employee Info" : "Name, number & hourly rates of attorneys/employees" : "Employee",
"Ledger Groupings" : "Ledger transactions belong to groups (e.g. trust, credit, hourly charge)" : "TrnsType",
"Footers in Bills" : "Text to print at bottom of statements for reminders/information" : "Footers",
"Rolodex Groups" : "Rolodex members belong to groups (e.g. client, opposing counsel, personal)" : "GrupLkup",
"Transaction Codes" : "Codes & descriptions of ledger transactions (e.g. PMT for payment)" : "TrnsLkup",
"Status of Files" : "Designate files as open, closed, contingent, bankrupt, etc." : "FileStat",
"States" : "Abbreviations & names of states" : "States"
ENDSUBMENU,
"Tally Accounts" : "Total ledger entries for all files" : "Tally_All"
ENDSUBMENU,
"System" : "Customize program for your office" : ""
SUBMENU
"Customize" : "Customize program for your office, letterhead, etc." : "Customize",
"Printers" : "Set up printers to use with application" : ""
SUBMENU
"Settings" : "Add, delete or change printer settings" : "Printers",
"Default" : "Select printer to use for output" : "Printer_Default"
ENDSUBMENU
ENDSUBMENU,
"Exit" : "Terminate application" : "Exit"
SUBMENU
"No " : "Do not exit - return to application" : "Exit\No",
"Yes " : "Exit application and return to DOS" : "Exit\Yes"
ENDSUBMENU
ENDMENU
ENDPROC; Show_Main_Menu
PROC CLOSED Main_Menu()
USEVARS Form_Dir, Main_Dir, Off_Lib, Autolib, Ltr_Hd, Appl_Title, Default_Printer
; disable some paradox keys
KEYDISABLE "DOS", "DOSBIG", "MINIEDIT", "ORDERTABLE", "WINNEXT"
; define report strings and read from disk
DYNARRAY Rpt_St[]
Rpt_St["Port"] = ""
Rpt_St["Page_Break"] = ""
Rpt_St["Setup_St"] = ""
Rpt_St["Reset_St"] = ""
Rpt_St["Phone_Book"] = ""
Rpt_St["Rolodex_Info"] = ""
Rpt_St["Envelope"] = ""
Rpt_St["File_Cabinet"] = ""
Rpt_St["Accounts"] = ""
Rpt_St["Statements"] = ""
Rpt_St["Calendar"] = ""
Rpt_St["B_Underline"] = ""
Rpt_St["E_Underline"] = ""
Rpt_St["B_Bold"] = ""
Rpt_St["E_Bold"] = ""
if NOT ISBLANK(Default_Printer) then
Setup_Printer(Default_Printer)
endif
Answer_Table = ""
WHILE TRUE
Show_Main_Menu()
GETMENUSELECTION TO Choice
Main_Table = Choice
SWITCH
CASE (Choice = "Rolodex") : Rolodex_Wait("Rolodex")
CASE (Choice = "Files") : File_Cabinet_Wait("Files", "Ledger")
CASE (Choice = "Pensions") : ECHO OFF
SETDIR "PENSIONS"
Pension_Table_Wait()
ECHO OFF
SETDIR Main_Dir
CASE (Choice = "QDROs") : Qdro_Table_Wait()
CASE (Choice = "Deposits") : Setup_Table_Wait(Choice, 2, 1, "1")
CASE (Choice = "PlanInfo") : Setup_Table_Wait(Choice, 1, 0, "1")
CASE (Choice = "Employee") : Setup_Table_Wait(Choice, 4, 14, "1")
CASE (Choice = "TrnsType") : Setup_Table_Wait(Choice, 6, 1, "1")
CASE (Choice = "Footers") : Setup_Table_Wait(Choice, 2, 0, "1")
CASE (Choice = "GrupLkup") : Setup_Table_Wait(Choice, 3, 1, "1")
CASE (Choice = "TrnsLkup") : Setup_Table_Wait(Choice, 2, 2, "1")
CASE (Choice = "FileStat") : Setup_Table_Wait(Choice, 4, 2, "1")
CASE (Choice = "FileType") : Setup_Table_Wait(Choice, 4, 23, "1")
CASE (Choice = "States") : Setup_Table_Wait(Choice, 3, 18, "1")
CASE (Choice = "Printers") : Setup_Table_Wait(Choice, 1, 2, "1")
; reset default printer values
if NOT Setup_Printer(Default_Printer) then
Select_Printer()
endif
CASE (Choice = "Printer_Default"): Select_Printer()
CASE (Choice = "Customize") : Customize_Setup()
CASE (Choice = "Tally_All") : Tally_All("Files", "Ledger")
CASE (Choice = "Exit\Yes") : QUITLOOP
ENDSWITCH
ENDWHILE
CLEARPULLDOWN
ENDPROC; Main_Menu
; =========== MAIN SCRIPT BEGINS HERE =======
; define subdirectory and library file where application is located
Form_Dir = "R:\\DOCUMENT\\WPDOCS\\FORMS\\"
Main_Dir = "R:\\PDOXDATA\\OFFICE\\" ; location of data files
Off_Lib = "OFFICE" ; name of procedure library
if ISFILE(Off_Lib + ".LIB") then ; look for procedure library
Autolib = SDIR() + Off_Lib ; autoload library
else Quit "Cannot locate library, please recreate."
endif
SETDIR Main_Dir
; define letterhead array/application title and read from disk
ARRAY Ltr_Hd[10]
; assign default printer & read in system variables
Default_Printer = Get_Custom_Setup_Variables()
; show splash screen
ECHO NORMAL ; display empty desktop
DYNARRAY Att[]
Att["HASFRAME"] = False
Att["CANMOVE"] = False
Att["CANRESIZE"] = False
Att["Style"] = 116
WINDOW CREATE ATTRIBUTES Att HEIGHT 13 WIDTH 52 @6,14 TO Splash_Screen
PAINTCANVAS BORDER ATTRIBUTE 16 0, 0, 12, 51
@5,1 ?? FORMAT("W50,AC", Appl_Title)
@7,1 ?? FORMAT("W50,AC","CLIENT AND BILLING DATABASE")
SLEEP 1000
FOR I FROM 6 TO 23
SLEEP 10
WINDOW MOVE Splash_Screen TO I,14
ENDFOR
WINDOW CLOSE
; execute top level procedure
Main_Menu()
ECHO OFF
SETDIR SDIR()
; clean up before exiting
RESET
RELEASE PROCS ALL
RELEASE VARS ALL

BIN
old-database/OFFICE.LIB Executable file
View File

Binary file not shown.

2002
old-database/Office/DEPOSITS.csv Normal file
View File

File diff suppressed because it is too large Load Diff

1
old-database/Office/EMPLOYEE.csv Normal file
View File

@@ -0,0 +1 @@
Empl_Num,Empl_Id,Rate_Per_Hour
1 Empl_Num Empl_Id Rate_Per_Hour

10
old-database/Office/FILENOTS.csv Normal file
View File

@@ -0,0 +1,10 @@
File_No,Memo_Date,Memo_Note
,,
,,
,,
,,
,,
,,
,,
,,
,,
1 File_No Memo_Date Memo_Note
2
3
4
5
6
7
8
9
10

1
old-database/Office/FILES.csv Normal file
View File

@@ -0,0 +1 @@
File_No,Id,File_Type,Regarding,Opened,Closed,Empl_Num,Rate_Per_Hour,Status,Footer_Code,Opposing,Hours,Hours_P,Trust_Bal,Trust_Bal_P,Hourly_Fees,Hourly_Fees_P,Flat_Fees,Flat_Fees_P,Disbursements,Disbursements_P,Credit_Bal,Credit_Bal_P,Total_Charges,Total_Charges_P,Amount_Owing,Amount_Owing_P,Transferable,Memo
1 File_No Id File_Type Regarding Opened Closed Empl_Num Rate_Per_Hour Status Footer_Code Opposing Hours Hours_P Trust_Bal Trust_Bal_P Hourly_Fees Hourly_Fees_P Flat_Fees Flat_Fees_P Disbursements Disbursements_P Credit_Bal Credit_Bal_P Total_Charges Total_Charges_P Amount_Owing Amount_Owing_P Transferable Memo

1
old-database/Office/FILESTAT.csv Normal file
View File

@@ -0,0 +1 @@
Status,Definition,Send,Footer_Code
1 Status Definition Send Footer_Code

1
old-database/Office/FILES_R.csv Normal file
View File

@@ -0,0 +1 @@
File_No,Relationship,Rolodex_Id
1 File_No Relationship Rolodex_Id

1
old-database/Office/FILES_V.csv Normal file
View File

@@ -0,0 +1 @@
File_No,Identifier,Response
1 File_No Identifier Response

1
old-database/Office/FILETYPE.csv Normal file
View File

@@ -0,0 +1 @@
File_Type
1 File_Type

1
old-database/Office/FOOTERS.csv Normal file
View File

@@ -0,0 +1 @@
F_Code,F_Footer
1 F_Code F_Footer

1
old-database/Office/FVARLKUP.csv Normal file
View File

@@ -0,0 +1 @@
Identifier,Query,Response
1 Identifier Query Response

1
old-database/Office/Forms/FORM_INX.csv Normal file
View File

@@ -0,0 +1 @@
Name,Keyword
1 Name Keyword

1
old-database/Office/Forms/FORM_LST.csv Normal file
View File

@@ -0,0 +1 @@
Name,Memo,Status
1 Name Memo Status

1
old-database/Office/Forms/INX_LKUP.csv Normal file
View File

@@ -0,0 +1 @@
Keyword
1 Keyword

1
old-database/Office/Forms/LIFETABL.csv Normal file
View File

@@ -0,0 +1 @@
AGE,LE_AA,NA_AA,LE_AM,NA_AM,LE_AF,NA_AF,LE_WA,NA_WA,LE_WM,NA_WM,LE_WF,NA_WF,LE_BA,NA_BA,LE_BM,NA_BM,LE_BF,NA_BF,LE_HA,NA_HA,LE_HM,NA_HM,LE_HF,NA_HF
1 AGE LE_AA NA_AA LE_AM NA_AM LE_AF NA_AF LE_WA NA_WA LE_WM NA_WM LE_WF NA_WF LE_BA NA_BA LE_BM NA_BM LE_BF NA_BF LE_HA NA_HA LE_HM NA_HM LE_HF NA_HF

1
old-database/Office/Forms/NUMBERAL.csv Normal file
View File

@@ -0,0 +1 @@
Month,NA_AA,NA_AM,NA_AF,NA_WA,NA_WM,NA_WF,NA_BA,NA_BM,NA_BF,NA_HA,NA_HM,NA_HF
1 Month NA_AA NA_AM NA_AF NA_WA NA_WM NA_WF NA_BA NA_BM NA_BF NA_HA NA_HM NA_HF

1
old-database/Office/GRUPLKUP.csv Normal file
View File

@@ -0,0 +1 @@
Code,Description,Title
1 Code Description Title

1
old-database/Office/LEDGER.csv Normal file
View File

@@ -0,0 +1 @@
File_No,Date,Item_No,Empl_Num,T_Code,T_Type,T_Type_L,Quantity,Rate,Amount,Billed,Note
1 File_No Date Item_No Empl_Num T_Code T_Type T_Type_L Quantity Rate Amount Billed Note

1
old-database/Office/PAYMENTS.csv Normal file
View File

@@ -0,0 +1 @@
Deposit_Date,File_No,Id,Regarding,Amount,Note
1 Deposit_Date File_No Id Regarding Amount Note

1
old-database/Office/PHONE.csv Normal file
View File

@@ -0,0 +1 @@
Id,Phone,Location
1 Id Phone Location

1
old-database/Office/PLANINFO.csv Normal file
View File

@@ -0,0 +1 @@
Plan_Id,Plan_Name,Plan_Type,Empl_Id_No,Plan_No,NRA,ERA,ERRF,COLAS,Divided_By,Drafted,Benefit_C,QDRO_C,^REV,^PA,Form_Name,Drafted_On,Memo
1 Plan_Id Plan_Name Plan_Type Empl_Id_No Plan_No NRA ERA ERRF COLAS Divided_By Drafted Benefit_C QDRO_C ^REV ^PA Form_Name Drafted_On Memo

1
old-database/Office/PRINTERS.csv Normal file
View File

@@ -0,0 +1 @@
Number,Name,Port,Page_Break,Setup_St,Phone_Book,Rolodex_Info,Envelope,File_Cabinet,Accounts,Statements,Calendar,Reset_St,B_Underline,E_Underline,B_Bold,E_Bold
1 Number Name Port Page_Break Setup_St Phone_Book Rolodex_Info Envelope File_Cabinet Accounts Statements Calendar Reset_St B_Underline E_Underline B_Bold E_Bold

1
old-database/Office/Pensions/DEATH.csv Normal file
View File

@@ -0,0 +1 @@
File_No,Version,Lump1,Lump2,Growth1,Growth2,Disc1,Disc2
1 File_No Version Lump1 Lump2 Growth1 Growth2 Disc1 Disc2

1
old-database/Office/Pensions/LIFETABL.csv Normal file
View File

@@ -0,0 +1 @@
AGE,LE_AA,NA_AA,LE_AM,NA_AM,LE_AF,NA_AF,LE_WA,NA_WA,LE_WM,NA_WM,LE_WF,NA_WF,LE_BA,NA_BA,LE_BM,NA_BM,LE_BF,NA_BF,LE_HA,NA_HA,LE_HM,NA_HM,LE_HF,NA_HF
1 AGE LE_AA NA_AA LE_AM NA_AM LE_AF NA_AF LE_WA NA_WA LE_WM NA_WM LE_WF NA_WF LE_BA NA_BA LE_BM NA_BM LE_BF NA_BF LE_HA NA_HA LE_HM NA_HM LE_HF NA_HF

1
old-database/Office/Pensions/MARRIAGE.csv Normal file
View File

@@ -0,0 +1 @@
File_No,Version,Married_From,Married_To,Married_Years,Service_From,Service_To,Service_Years,Marital_%
1 File_No Version Married_From Married_To Married_Years Service_From Service_To Service_Years Marital_%

1
old-database/Office/Pensions/NUMBERAL.csv Normal file
View File

@@ -0,0 +1 @@
Month,NA_AA,NA_AM,NA_AF,NA_WA,NA_WM,NA_WF,NA_BA,NA_BM,NA_BF,NA_HA,NA_HM,NA_HF
1 Month NA_AA NA_AM NA_AF NA_WA NA_WM NA_WF NA_BA NA_BM NA_BF NA_HA NA_HM NA_HF

1
old-database/Office/Pensions/PENSIONS.csv Normal file
View File

@@ -0,0 +1 @@
File_No,Version,Plan_Id,Plan_Name,Title,First,Last,Birth,Race,Sex,Info,Valu,Accrued,Vested_Per,Start_Age,COLA,Max_COLA,Withdrawal,Pre_DR,Post_DR,Tax_Rate
1 File_No Version Plan_Id Plan_Name Title First Last Birth Race Sex Info Valu Accrued Vested_Per Start_Age COLA Max_COLA Withdrawal Pre_DR Post_DR Tax_Rate

1
old-database/Office/Pensions/RESULTS.csv Normal file
View File

@@ -0,0 +1 @@
Accrued,Start_Age,COLA,Withdrawal,Pre_DR,Post_DR,Tax_Rate,Age,Years_From,Life_Exp,EV_Monthly,Payments,Pay_Out,Fund_Value,PV,Mortality,PV_AM,PV_AMT,PV_Pre_DB,PV_Annuity,WV_AT,PV_Plan,Years_Married,Years_Service,Marr_Per,Marr_Amt
1 Accrued Start_Age COLA Withdrawal Pre_DR Post_DR Tax_Rate Age Years_From Life_Exp EV_Monthly Payments Pay_Out Fund_Value PV Mortality PV_AM PV_AMT PV_Pre_DB PV_Annuity WV_AT PV_Plan Years_Married Years_Service Marr_Per Marr_Amt

1
old-database/Office/Pensions/SCHEDULE.csv Normal file
View File

@@ -0,0 +1 @@
File_No,Version,Vests_On,Vests_At
1 File_No Version Vests_On Vests_At

1
old-database/Office/Pensions/SEPARATE.csv Normal file
View File

@@ -0,0 +1 @@
File_No,Version,Separation_Rate
1 File_No Version Separation_Rate

1
old-database/Office/QDROS.csv Normal file
View File

@@ -0,0 +1 @@
File_No,Version,Plan_Id,^1,^2,^Part,^AltP,^Pet,^Res,Case_Type,Case_Code,Section,Case_Number,Judgment_Date,Valuation_Date,Married_On,Percent_Awarded,Ven_City,Ven_Cnty,Ven_St,Draft_Out,Draft_Apr,Final_Out,Judge,Form_Name
1 File_No Version Plan_Id ^1 ^2 ^Part ^AltP ^Pet ^Res Case_Type Case_Code Section Case_Number Judgment_Date Valuation_Date Married_On Percent_Awarded Ven_City Ven_Cnty Ven_St Draft_Out Draft_Apr Final_Out Judge Form_Name

1
old-database/Office/ROLEX_V.csv Normal file
View File

@@ -0,0 +1 @@
Id,Identifier,Response
1 Id Identifier Response

1
old-database/Office/ROLODEX.csv Normal file
View File

@@ -0,0 +1 @@
Id,Prefix,First,Middle,Last,Suffix,Title,A1,A2,A3,City,Abrev,St,Zip,Email,DOB,SS#,Legal_Status,Group,Memo
1 Id Prefix First Middle Last Suffix Title A1 A2 A3 City Abrev St Zip Email DOB SS# Legal_Status Group Memo

1
old-database/Office/RVARLKUP.csv Normal file
View File

@@ -0,0 +1 @@
Identifier,Query
1 Identifier Query

1
old-database/Office/SETUP.csv Normal file
View File

@@ -0,0 +1 @@
Appl_Title,L_Head1,L_Head2,L_Head3,L_Head4,L_Head5,L_Head6,L_Head7,L_Head8,L_Head9,L_Head10,Default_Printer
1 Appl_Title L_Head1 L_Head2 L_Head3 L_Head4 L_Head5 L_Head6 L_Head7 L_Head8 L_Head9 L_Head10 Default_Printer

1
old-database/Office/STATES.csv Normal file
View File

@@ -0,0 +1 @@
Abrev,St
1 Abrev St

1
old-database/Office/TRNSACTN.csv Normal file
View File

@@ -0,0 +1 @@
File_No,Id,Footer_Code,Date,Item_No,Empl_Num,T_Code,T_Type,T_Type_L,Quantity,Rate,Amount,Billed,Note
1 File_No Id Footer_Code Date Item_No Empl_Num T_Code T_Type T_Type_L Quantity Rate Amount Billed Note

1
old-database/Office/TRNSLKUP.csv Normal file
View File

@@ -0,0 +1 @@
T_Code,T_Type,T_Type_L,Amount,Description
1 T_Code T_Type T_Type_L Amount Description

1
old-database/Office/TRNSTYPE.csv Normal file
View File

@@ -0,0 +1 @@
T_Type,T_Type_L,Header,Footer
1 T_Type T_Type_L Header Footer

685
old-database/PENSION.SC Executable file
View File

@@ -0,0 +1,685 @@
MESSAGE "Writing pension procedures to library..."
PROC Ask_For_Output()
PRIVATE File_Id
Subset_Table = "P_Output"
ECHO OFF
FORMKEY
MOVETO "Output"
MOVETO FIELD "File_No"
File_Id = [Pensions->File_No] + [Pensions->Version]
LOCATE File_Id
if RetVal then ; output record located
COPYTOARRAY Temp_Array
CREATE Subset_Table LIKE "Output"
VIEW Subset_Table
COEDITKEY
COPYFROMARRAY Temp_Array
DO_IT!
FORMKEY
Select_Forms()
DELETE Subset_Table
else MESSAGE("Please compute and save results of this entry first!")
endif
MOVETO "Pensions"
FORMKEY
ENDPROC;
WRITELIB Off_Lib Ask_For_Output
PROC Discount(DR, IR, Max_COLA, Pmts, Monthly)
PRIVATE COLA, PV_Pmt, Months_Delayed
DR = DR * 0.01/12
; if (IR = 0) then
; Payout = Round(Pmts * Monthly,0)
; Fund_Bal = Round(PV(Monthly, DR, Pmts),0)
; else
; F = "TEMP.TXT"
; FILEWRITE F FROM "This is a printout of the annuity stream."+"\n"+"\n"
Months_Delayed = 12; number of monthly payments until COLA kicks in
Payout = 0
Fund_Bal = 0
DR = 1/(1+DR)
FOR N FROM 1 to Pmts
if (IR > 0.0) then
if (N > Months_Delayed) AND (MOD(N,12) = 1) then
if (IR < 1.0) then
COLA = Round(Monthly*IR,2)
else COLA = IR
endif
if (Max_COLA > 0.0) AND (COLA > Max_COLA) then
COLA = Max_COLA
endif
Monthly = Monthly + COLA
endif; (if N > Months_Delayed AND Divisible by 12)
endif; (if Increase Rate > 0.0)
Payout = Payout + Monthly
PV_Pmt = Round(Monthly * Round(POW(DR,N),5),2)
Fund_Bal = Fund_Bal + PV_Pmt
; PRINT FILE F FORMAT("W5", N), FORMAT("W15.2,EC", Monthly), FORMAT("W15.2,EC", Payout), FORMAT("W15.2,EC", PV_Pmt), FORMAT("W15.2,EC", Fund_Bal),"\n"
ENDFOR; FOR N FROM 1 to Pmts
Payout = Round(Payout,0)
Fund_Bal = Round(Fund_Bal,0)
; endif; if (IR > 0)
Last_Pmt = Monthly
ENDPROC;
WRITELIB Off_Lib Discount
PROC Life_Stats( Age_1, Age_2, Race_Sex_Code )
PRIVATE
I, N,
Alive_Now, Alive_Then
FORMKEY; get out of pension table form view
MOVETO Life_Table
MOVETO FIELD "Age"
LOCATE INT(Age_1) ; integer, current age
MOVETO FIELD "NA_" + Race_Sex_Code
; F = "TEMP.TXT"
FOR I FROM 1 to ARRAYSIZE(Num_Alive) ; copy number alive to array
Num_Alive[I] = []
; PRINT FILE F FORMAT( "W9.2", I )
; PRINT FILE F FORMAT( "W9.2", Num_Alive[I] ), "\n"
DOWN
ENDFOR
I = ARRAYSIZE(Num_Alive)
Alive_Now = Round(Num_Alive[1]-(Num_Alive[1]-Num_Alive[2])*(Age_1-INT(Age_1)),0)
Alive_Then = Round(Num_Alive[I-1]-(Num_Alive[I-1]-Num_Alive[I])*(Age_2-INT(Age_2)),0)
Num_Alive[1] = Alive_Now
Num_Alive[I] = Alive_Then
; PRINT FILE F FORMAT( "W9.2", Num_Alive[1] ), "\n"
; PRINT FILE F FORMAT( "W9.2", Num_Alive[I] ), "\n"
Mortality = Round((Alive_Then/Alive_Now), 4)
if (Mortality > 1.0) then
Mortality = 1.0
endif
LEFT
UP
N = []
UP
I = []
LE = Round(I-(I-N)*(Age_2-INT(Age_2)),2)
ENDPROC;
WRITELIB Off_Lib Life_Stats
PROC Is_Vested(Full, Per_Vested, V_Date)
; check for expected value of future vesting
PRIVATE
I, Prob, Expected
Expected = Round(Full*Per_Vested*0.01, 2)
if (Per_Vested < 100.0) then
MOVETO "Separate"
if (NIMAGERECORDS() > 0) then
Prob = 1 - [Separation_Rate] * 0.01
if (Prob < 1.0) then
MOVETO "Schedule"
FOR I FROM 1 TO NIMAGERECORDS()
MOVETO RECORD I
if ([Vests_On]<> BLANKDATE()) And ([Vests_At] > 0.0) then
Expected = Expected + Round(Full*[Vests_At]*0.01*POW(Prob, ([Vests_On]-[Pensions->Valu])/365 ), 2)
endif
ENDFOR
endif
endif
MOVETO "Pensions" ; move to next table
endif
RETURN Expected
ENDPROC;
WRITELIB Off_Lib Is_Vested
PROC Death_Benefit(Is_Age, Pay_Age, Last_Pmt)
; check for death benefit -- Lump1, Lump2
PRIVATE
N, I,
DB_1, DB_2,
B1, B2,
Partial,
Probability,
B_Age,
B_Starts
MOVETO "Death"
DB_1 = 0.0
DB_2 = 0.0
if (NIMAGERECORDS() > 0) then
if ([Lump1] > 0.0) Or ([Lump2] > 0.0) then
B1 = [Lump1]
B2 = [Lump2]
N = ARRAYSIZE(Num_Alive)
FOR I FROM 1 to N - 1
Probability = 1 - Round(Num_Alive[I+1]/Num_Alive[I], 5)
if (I = 1) then
Partial = Is_Age - INT(Is_Age)
else if (I = N - 1) then
Partial = Pay_Age - INT(Pay_Age)
else Partial = 1
endif
endif
B1 = Round(B1*(1+[Growth1]*.01*Partial)/(1+[Disc1]*.01*Partial), 0)
B2 = Round(B2*(1+[Growth2]*.01*Partial)/(1+[Disc2]*.01*Partial), 0)
DB_1 = DB_1 + Round((B1+B2)*Probability,0)
ENDFOR
endif ; pre-payment lump sum distribution
endif ; a record exists
R["PV_Pre_DB"] = DB_1
R["PV_Annuity"] = R["PV_AMT"] + DB_1
if (R["PV_Annuity"] >= R["WV_AT"]) then
R["PV_Plan"] = R["PV_Annuity"]
else R["PV_Plan"] = R["WV_AT"]
endif
ENDPROC;
WRITELIB Off_Lib Death_Benefit
PROC Marriage_Factor()
; check for marriage factor --- first dates, then years, finally %
PRIVATE
M, S, M_Per
MOVETO "Marriage"
M = 0.0
S = 0.0
M_Per = 100.0
if (NIMAGERECORDS() > 0) then
; calculate years married based on dates, or accept entry
if ([Married_From] <> BLANKDATE()) And ([Married_To] <> BLANKDATE()) then
M = Round(([Married_To]-[Married_From])/365,2)
[Married_Years] = M
else if ([Married_Years] > 0.0) then
M = [Married_Years]
endif
endif
; calculate years of service based on dates, or accept entry
if ([Service_From] <> BLANKDATE()) And ([Service_To] <> BLANKDATE()) then
S = Round(([Service_To]-[Service_From])/365,2)
[Service_Years] = S
else if ([Service_Years] > 0.0) then
S = [Service_Years]
endif
endif
; calculate marriage factor, or accept entry
if (M > 0.0) And (S >= M) then
M_Per = Round(M/S, 4) * 100
[Marital_%] = M_Per
else if ([Marital_%] > 0.0) then
M_Per = [Marital_%]
endif
endif
endif; if an image is present
R["Years_Married"] = M
R["Years_Service"] = S
R["Marr_Per"] = M_Per
R["Marr_Amt"] = Round(M_Per * 0.01 * R["PV_Plan"], 0)
MOVETO "Pensions"
ENDPROC;
WRITELIB Off_Lib Marriage_Factor
PROC Save_Results()
PRIVATE File_Id, I, J
MESSAGE "Saving results of calculation..."
FORMKEY; put results table into table view
CTRLHOME
DYNARRAY Transfer[]
J = NFIELDS("Results")
FOR I FROM 1 TO J
TAB
Transfer[FIELD()] = FIELDSTR()
ENDFOR
DEL
MOVETO "Output"
MOVETO FIELD "File_No"
File_Id = [Pensions->File_No] + [Pensions->Version]
LOCATE File_Id
if (RetVal = False) then
END
DOWN ; open up a blank row
endif
[File_No] = File_Id
FOREACH Element IN Transfer
MOVETO FIELD Element
[] = Transfer[Element]
ENDFOREACH
if (R["Mortality"] < 1.0) then
[Mortality] = "0" + [Mortality]
endif
[Title] = [Pensions->Title]
[First] = [Pensions->First]
[Last] = [Pensions->Last]
if ( SUBSTR([Last], LEN([Last]), 1) = "s") then
[Last's] = [Last] + "'"
else [Last's] = [Last] + "'s"
endif
[Plan_Name] = [Pensions->Plan_Name]
[Birth] = FORMAT("d1", [Pensions->Birth])
if (SEARCH(" ", [Birth]) = 1) then
[Birth] = "0" + SUBSTR([Birth], 2, 7)
endif
[Race] = [Pensions->Race]
[Sex] = [Pensions->Sex]
[Info] = FORMAT("d2", [Pensions->Info])
I = SEARCH(" ", [Info])
if (I > 1) then
[Info] = SUBSTR([Info], 1, I) + SUBSTR([Info], I+2, 15)
endif
[Valu] = FORMAT("d2", [Pensions->Valu])
I = SEARCH(" ", [Valu])
if (I > 1) then
[Valu] = SUBSTR([Valu], 1, I) + SUBSTR([Valu], I+2, 15)
endif
[Vested_Per] = FORMAT("w7.2", [Pensions->Vested_Per])
if ([Pensions->Vested_Per] < 100.0) then
[Vest_Amt_Text] = "Monthly Benefit Reduced For Probability of Vesting"
endif
if ([Pensions->COLA] > 0.0) then
[Cola_Text] = "Expected Annual Increase In Benefits"
if ([Pensions->COLA] > 1.0) then
[COLA] = FORMAT("W7.2, E$", [Pensions->COLA])
else [COLA] = FORMAT("W5.2", [Pensions->COLA]*100) + "%"
endif
endif
[Initial_Amt_Text] = "Accrued Monthly Benefit"
if ([Pensions->Pre_DR] = 0) then
[Initial_Amt_Text] = "Present Value of Monthly Annuity"
[PV_Plan_Text] = "Money Purchase Annuity Benefit"
else if ([Pensions->Pre_DR] < [Pensions->Post_DR]) then
[PV_Plan_Text] = "Money Purchase Annuity Benefit"
else [PV_Plan_Text] = "Formula Method Annuity Benefit "
endif
endif
if (R["PV_Annuity"] < R["WV_AT"]) then
[PV_Plan_Text] = "Separation Benefit"
endif
if ([Pensions->Tax_Rate] > 0.0) then
[V_Title] = "after-tax present value"
[Tax_Rate_Text] = "Estimated Tax Liability"
[PV_AT_Text] = "After-tax Present Value of Annuity"
else [V_Title] = ""
[Tax_Rate_Text] = ""
[PV_AT_Text] = ""
endif
if ([Pensions->Withdrawal] > 0.0) then
[With_Text] = "Lump Sum Payment Option in Lieu of Annuity"
if ([Pensions->Tax_Rate] > 0) then
[With_AT_Text] = " After-tax Value of Lump Sum Payment Option"
endif
else [With_Text] = "No lump sum payment option available"
[With_AT_Text] = ""
endif
if (R["PV_Pre_DB"] > 0.0) then
[PV_Ann_Text] = "Total Present Value, Including Death Benefit"
[Pre_DB_Text] = "Present Value of Pre-retirement Death Benefit"
else [Pre_DB_Text] = ""
endif
if (R["Marr_Per"] < 100.0) then
[Years_Married] = FORMAT("W7.2", R["Years_Married"])
[Years_Service] = FORMAT("W7.2", R["Years_Service"])
[Married_Text] = "Years of Service While Married"
[Service_Text] = "Total Years of Plan Service"
[Marr_Per_Text] = "Percent of Benefit Accrued While Married"
[Marr_Amt_Text] = "Marital Component"
else [Married_Text] = ""
[Service_Text] = ""
[Marr_Per_Text] = ""
[Marr_Amt_Text] = ""
endif
MESSAGE ""
ENDPROC;
WRITELIB Off_Lib Save_Results
PROC Life_Exp_Compute()
PRIVATE
LE,
Mortality,
Payout,
Fund_Bal,
Last_Pmt
ECHO OFF
if (SYSMODE() <> "CoEdit") then
COEDITKEY
endif
MOVETO "Pensions"
POSTRECORD NOPOST LEAVELOCKED
if NOT RetVal then
MESSAGE "Duplicate file/version entry - please change!"
MOVETO FIELD "Version"
RETURN
endif
MESSAGE "Computing present value..."
R["Age"] = Round(([Valu]-[Birth])/365.25, 2)
if ([Start_Age] > R["Age"]) then
R["Start_Age"] = [Start_Age]
else R["Start_Age"] = R["Age"]
[Start_Age] = R["Age"]
POSTRECORD NOPOST
endif
R["Accrued"] = [Accrued]
R["COLA"] = [COLA]
R["Pre_DR"] = [Pre_DR]
R["Post_DR"] = [Post_DR]
R["Tax_Rate"] = [Tax_Rate]
R["Years_From"] = R["Start_Age"] - R["Age"]
ARRAY Num_Alive[INT(R["Start_Age"])-INT(R["Age"])+2]
; get life expectancy and mortality factor
Life_Stats(R["Age"], R["Start_Age"], SUBSTR([Race],1,1)+SUBSTR([Sex],1,1))
MOVETO "Pensions"
FORMKEY; return to form view
R["Life_Exp"] = LE
R["Payments"] = INT(LE*12)
R["Mortality"] = Mortality
R["EV_Monthly"] = Is_Vested([Accrued], [Vested_Per], [Valu])
Discount([Post_DR], [COLA], [Max_COLA], R["Payments"], R["EV_Monthly"])
R["Pay_Out"] = Payout
R["Fund_Value"] = Fund_Bal
R["PV"] = Round(Fund_Bal * POW((1+[Pre_DR]*0.01/12), -R["Years_From"]*12), 0)
R["PV_AM"] = Round(R["PV"] * Mortality, 0 )
R["PV_AMT"] = Round(R["PV_AM"] * (1-[Tax_Rate]*0.01), 0)
R["Withdrawal"] = [Withdrawal]
R["WV_AT"] = Round(R["Withdrawal"] * (1-[Tax_Rate]*0.01), 0)
Death_Benefit( R["Age"], R["Start_Age"], Last_Pmt )
Marriage_Factor()
POSTRECORD NOPOST
FORMKEY
MOVETO "Results"
COPYFROMARRAY R
PICKFORM 1
MESSAGE ""
PROMPT " Press ESC when finished viewing."
BEEP
WAIT FIELD
UNTIL "ESC"
PROMPT ""
if Response_Is_Yes("SAVE RESULTS", "Save Results of PV Calculation?") then
Save_Results()
else DEL
endif
MOVETO "Pensions"
FORMKEY ; redisplay pension form
PROMPT Prompt_String
ENDPROC;
WRITELIB Off_Lib Life_Exp_Compute
PROC Actuarial_Compute()
PRIVATE
Increase, Race_Sex_Code, Monthly, COLA, Max_COLA, Pre_Dr, Post_DR, TEP, PV_TEP, PV_TEP_NOW
TEP = 0
PV_TEP = 0
PV_TEP_NOW = 0
ECHO OFF
if (SYSMODE() <> "CoEdit") then
COEDITKEY
endif
MOVETO "Pensions"
POSTRECORD NOPOST LEAVELOCKED
if NOT RetVal then
MESSAGE "Duplicate file/version entry - please change!"
MOVETO FIELD "Version"
RETURN
endif
MESSAGE "Computing present value..."
R["Age"] = Round(([Valu]-[Birth])/365.25, 2)
if ([Start_Age] > R["Age"]) then
R["Start_Age"] = [Start_Age]
else R["Start_Age"] = R["Age"]
[Start_Age] = R["Age"]
POSTRECORD NOPOST
endif
Current_Age = INT(R["Age"] * 12)
Start_Age = INT(R["Start_Age"] * 12)
First_Payment_Age = Start_Age + 1 ; first payment is made one month after retirement
Array_Size = 1200 - Start_Age
Array Pmt_Age[Array_Size]
ARRAY Num_Alive[Array_Size]
ARRAY Prob_Surv[Array_Size]
ARRAY Payment[Array_Size]
ARRAY EV_Payment[Array_Size]
ARRAY Disc_Factor[Array_Size]
ARRAY EPV_Payment[Array_Size]
R["Accrued"] = [Accrued]
R["EV_Monthly"] = Is_Vested([Accrued], [Vested_Per], [Valu])
R["COLA"] = [COLA]
R["Pre_DR"] = [Pre_DR]
R["Post_DR"] = [Post_DR]
R["Tax_Rate"] = [Tax_Rate]
R["Years_From"] = R["Start_Age"] - R["Age"]
R["Tax_Rate"] = [Tax_Rate]
R["Withdrawal"] = [Withdrawal]
R["WV_AT"] = Round(R["Withdrawal"] * (1-[Tax_Rate]*0.01), 0)
Race_Sex_Code = SUBSTR([Race],1,1) + SUBSTR([Sex],1,1)
Monthly = R["EV_Monthly"]
COLA = [COLA]
Max_COLA = [Max_COLA]
Increase = COLA
Pre_DR = [Pre_DR]
Pre_DR = 1/(1+Pre_DR*0.01/12)
Post_DR = [Post_DR]
Post_DR = 1/(1+Post_DR*0.01/12)
; (******************* New portion of code ***************)
FORMKEY; get out of pension table form view
MOVETO Mort_Table
MOVETO FIELD "Month"
LOCATE Current_Age
MOVETO FIELD "NA_" + Race_Sex_Code
Num_Alive_Now = []
MOVETO FIELD "Month"
LOCATE First_Payment_Age
MOVETO FIELD "NA_" + Race_Sex_Code
FOR I FROM 1 to Array_Size ; copy number alive to array
Num_Alive[I] = []
Pmt_Age[I] = Start_Age + I
Prob_Surv[I] = Round((Num_Alive[I] / Num_Alive_Now), 6)
if (Increase > 0.0) then
if (I > 12) AND (MOD(I,12) = 1) then
if (Increase < 1.0) then
COLA = Round(Monthly * Increase,2)
else COLA = Increase
endif
if (Max_COLA > 0.0) AND (COLA > Max_COLA) then
COLA = Max_COLA
endif
Monthly = Monthly + COLA
endif; (if I > 12 AND Remainder = 1)
endif; (if Increase > 0.0)
Payment[I] = Monthly
EV_Payment[I] = Round((Monthly * Prob_Surv[I]), 2)
TEP = TEP + EV_Payment[I]
Disc_Factor[I] = Round(POW(Post_DR,I),6)
EPV_Payment[I] = Round((EV_Payment[I] * Disc_Factor[I]), 2)
PV_TEP = PV_TEP + EPV_Payment[I]
if (I < Array_Size) then
DOWN
endif
ENDFOR
TEP = Round(TEP,0)
PV_TEP = Round(PV_TEP,0)
PV_TEP_NOW = Round(PV_TEP * Round(POW(Pre_DR,(Start_Age-Current_Age)),6),0)
Print_To_File = "N"
if (Print_To_File = "Y") then
F = "TEMP.TXT"
FILEWRITE F FROM "This is a printout of the annuity stream. \n \n"
PRINT FILE F "Current Age: ", FORMAT("W9", Current_Age), "\n"
PRINT FILE F "Age at First Payment: ", FORMAT("W9", First_Payment_Age), "\n"
PRINT FILE F "Number Alive at Present: ", FORMAT( "W9", Num_Alive_Now), "\n", "\n", "\n", "\n"
PRINT FILE F "Pmt # Age #Alive Prob. Surv. Payment Exp. Value Disc. Fact. PVEP", "\n", "\n"
FOR I FROM 1 to Array_Size
PRINT FILE F FORMAT( "W6", I )
PRINT FILE F FORMAT( "W6", Pmt_Age[I] )
PRINT FILE F FORMAT( "W9", Num_Alive[I] )
PRINT FILE F FORMAT( "W10.6", Prob_Surv[I] )
PRINT FILE F FORMAT( "W12.2", Payment[I] )
PRINT FILE F FORMAT( "W12.2", EV_Payment[I] )
PRINT FILE F FORMAT( "W14.6", Disc_Factor[I] )
PRINT FILE F FORMAT( "W14.2", EPV_Payment[I] ), "\n"
ENDFOR
PRINT FILE F "\n"
PRINT FILE F "Totals: ", FORMAT( "W10", TEP), FORMAT( "W28", PV_TEP), "\n", "\n"
PRINT FILE F "Total Expected Payout: ", FORMAT( "W10", TEP), "\n", "\n"
PRINT FILE F "Total Present Value of Expected Payments @ Commencement: ", FORMAT( "W10", PV_TEP), "\n", "\n"
PRINT FILE F "Total Present Value of Expected Payments Now: ", FORMAT( "W10", PV_TEP_Now), "\n", "\n"
endif; Print_To_File = "Y"
MOVETO "Pensions"
FORMKEY; return to form view
R["Life_Exp"] = 0.0
R["Payments"] = 0.0
R["Mortality"] = 0.0
R["PV_AM"] = 0.0
R["Pay_Out"] = TEP
R["Fund_Value"] = PV_TEP
R["PV"] = PV_TEP_NOW
R["PV_AMT"] = Round(R["PV"] * (1-[Tax_Rate]*0.01), 0)
; skip death benefit calculation for now, set DB values to zero
; Death_Benefit( R["Age"], R["Start_Age"], Monthly )
R["PV_Pre_DB"] = 0.0
R["PV_Annuity"] = R["PV_AMT"] + R["PV_Pre_DB"]
if (R["PV_Annuity"] >= R["WV_AT"]) then
R["PV_Plan"] = R["PV_Annuity"]
else R["PV_Plan"] = R["WV_AT"]
endif
; (******************* balance of original compute procedure ***************)
Marriage_Factor()
POSTRECORD NOPOST
FORMKEY
MOVETO "Results"
COPYFROMARRAY R
PICKFORM 1
MESSAGE ""
PROMPT " Press ESC when finished viewing."
BEEP
WAIT FIELD
UNTIL "ESC"
PROMPT ""
if Response_Is_Yes("SAVE RESULTS", "Save Results of PV Calculation?") then
Save_Results()
else DEL
endif
MOVETO "Pensions"
FORMKEY; redisplay pension form
PROMPT Prompt_String
ENDPROC;
WRITELIB Off_Lib Actuarial_Compute
PROC Pension_Wait_Proc(TriggerType, EventInfo, CycleNumber)
PRIVATE Key_Code, Menu_Pick
if (EventInfo["TYPE"] = "KEY") then
Key_Code = EventInfo["KEYCODE"]
SWITCH
; ALT A - Compute Using Actuarial Method
CASE (Key_Code = -30) : if ISFIELDVIEW() then
DO_IT!
endif
MOVETO "Pensions"
Actuarial_Compute() ; pv of a pension
Main_Table_Menu()
RETURN 1
; ALT L - Compute using Life Exepctancy Method
CASE (Key_Code = -38) : if ISFIELDVIEW() then
DO_IT!
endif
MOVETO "Pensions"
Life_Exp_Compute() ; pv of a pension
Main_Table_Menu()
RETURN 1
; F9 - COEDIT
CASE (Key_Code = -67) : RETURN Main_Table_Edit()
; F2 - DO_IT!
CASE (Key_Code = -60) : if ISEMPTY(Main_Table) then
RETURN Main_Table_Clear()
else RETURN Main_Table_End_Edit()
endif
; F8 - CLEAR
CASE (Key_Code = -66) : RETURN Main_Table_Clear()
; DELETE
CASE (Key_Code = -83) : if (SYSMODE() = "CoEdit") then
RETURN Display_Delete_Box()
else RETURN 1
endif
; + or - to change date by day
CASE (Key_Code = 43) OR
(Key_Code = 45) : RETURN Change_Date(Key_Code)
OTHERWISE : SOUND 400 100 RETURN 1
ENDSWITCH
endif
if (EventInfo["MESSAGE"] = "MENUSELECT") then
Menu_Pick = EventInfo["MENUTAG"]
SWITCH
CASE (Menu_Pick = "Edit\Mode") : RETURN Main_Table_Edit()
CASE (Menu_Pick = "Main\Mode") : if ISEMPTY(Main_Table) then
RETURN Main_Table_Clear()
else RETURN Main_Table_End_Edit()
endif
CASE (Menu_Pick = "Ask") : Ask_For_Output()
RETURN 1
CASE (Menu_Pick = "Close\Yes") : RETURN Main_Table_Clear()
CASE (Menu_Pick = "Close\No") : RETURN 1
OTHERWISE : SOUND 400 100 RETURN 1
ENDSWITCH
endif
SOUND 400 100 RETURN 1 ; safety valve
ENDPROC
WRITELIB Off_Lib Pension_Wait_Proc
PROC Pension_Table_Wait()
; Life Expectancy Method uses LifeTabl
Life_Table = "LifeTabl"
; Actuarial Method uses NumberAl Mortailty Table
Mort_Table = "NumberAl"
R_Table = "Results"
Prompt_String = " Alt-L for Life Expectancy Method; Alt-A for Actuarial Method"
Main_Table_View("Pensions", 1, 0); place pension table on workspace in form view
ECHO OFF
END; move to last record in pension table
FORMKEY; move from form view to table view
VIEW Life_Table
VIEW Mort_Table
VIEW "Output"
VIEW R_Table
COEDITKEY
COPYTOARRAY R
DO_IT!
MOVETO "Pensions"
FORMKEY
Main_Table_Edit()
PROMPT Prompt_String
ECHO NORMAL
WAIT WORKSPACE
PROC "Pension_Wait_Proc"
MESSAGE "MENUSELECT"
; TRIGGER "ARRIVEFIELD"
KEY -60, -66, -67, -83, -38, -30, 43, 45
; DO_IT Clear Edit Delete Alt-L Alt-A + -
; F2 F8 F9 DEL LECompute ActCompute
ENDWAIT
ECHO OFF
EMPTY "Output"; empty output table every time script is exited
CLEARALL
PROMPT ""
MESSAGE ""
ENDPROC;
WRITELIB Off_Lib Pension_Table_Wait
RELEASE PROCS ALL

BIN
old-database/PENSION.SC2 Executable file
View File

Binary file not shown.

104
old-database/QDRO.SC Executable file
View File

@@ -0,0 +1,104 @@
MESSAGE "Writing QDRO procedures to library..."
; Off_Lib = "OFFICE"
PROC QDRO_Output()
PRIVATE Temp_Array
ECHO OFF
COPYTOARRAY Temp_Array
;
; Added check for user and alternatives to "Q_Output"
;
User = SUBSTR(USERNAME(), 1, 5)
User = "JESSE"
if (User = "JESSE") then
Subset_Table = "Q_Output"
else
Subset_Table = "Q_" + SUBSTR(USERNAME(), 1, 3) + "001"
endif
if ISTABLE(Subset_Table) then
DELETE Subset_Table
endif
CREATE Subset_Table LIKE "Qdros"
VIEW Subset_Table
COEDITKEY
COPYFROMARRAY Temp_Array
[File_No] = [Qdros->File_No] + [Qdros->Version]
DO_IT!
FORMKEY
Select_Forms()
DELETE Subset_Table
MOVETO Main_Table
FORMKEY
ENDPROC;
WRITELIB Off_Lib QDRO_Output
PROC QDRO_Wait_Proc(TriggerType, EventInfo, CycleNumber)
PRIVATE Key_Code, Menu_Pick
if (EventInfo["TYPE"] = "KEY") then
Key_Code = EventInfo["KEYCODE"]
SWITCH
; F9 - COEDIT
CASE (Key_Code = -67) : RETURN Main_Table_Edit()
; F2 - DO_IT!
CASE (Key_Code = -60) : if ISEMPTY(Main_Table) then
RETURN Main_Table_Clear()
else RETURN Main_Table_End_Edit()
endif
; F8 - CLEAR
CASE (Key_Code = -66) : RETURN Main_Table_Clear()
; DELETE
CASE (Key_Code = -83) : if (SYSMODE() = "CoEdit") then
RETURN Display_Delete_Box()
else RETURN 1
endif
; + or - to change date by day
CASE (Key_Code = 43) OR
(Key_Code = 45) : RETURN Change_Date(Key_Code)
OTHERWISE : SOUND 400 100 RETURN 1
ENDSWITCH
endif
if (EventInfo["MESSAGE"] = "MENUSELECT") then
Menu_Pick = EventInfo["MENUTAG"]
SWITCH
CASE (Menu_Pick = "Edit\Mode") : RETURN Main_Table_Edit()
CASE (Menu_Pick = "Main\Mode") : if ISEMPTY(Main_Table) then
RETURN Main_Table_Clear()
else RETURN Main_Table_End_Edit()
endif
CASE (Menu_Pick = "Ask") : QDRO_Output()
RETURN 1
CASE (Menu_Pick = "Close\Yes") : RETURN Main_Table_Clear()
CASE (Menu_Pick = "Close\No") : RETURN 1
OTHERWISE : SOUND 400 100 RETURN 1
ENDSWITCH
endif
SOUND 400 100 RETURN 1 ; safety valve
ENDPROC
WRITELIB Off_Lib QDRO_Wait_Proc
PROC QDRO_Table_Wait()
Main_Table = "Qdros"
ECHO OFF
Main_Table_View(Main_Table, 1, 0); place table on workspace in form view
END; move to last record in table
Main_Table_Edit()
ECHO NORMAL
WAIT WORKSPACE
PROC "QDRO_Wait_Proc"
MESSAGE "MENUSELECT"
; TRIGGER "ARRIVEFIELD"
KEY -60, -66, -67, -83, 43, 45
; DO_IT Clear Edit Delete + -
; F2 F8 F9 DEL
ENDWAIT
ECHO OFF
CLEARALL
PROMPT ""
MESSAGE ""
ENDPROC;
WRITELIB Off_Lib QDRO_Table_Wait
RELEASE PROCS ALL

BIN
old-database/QDRO.SC2 Executable file
View File

Binary file not shown.

388
old-database/ROLODEX.SC Executable file
View File

@@ -0,0 +1,388 @@
MESSAGE "Writing rolodex procedures to library..."
PROC Rolodex_Wait(M_Tbl)
PRIVATE Fld_Prompt, Answer_Menu
PROC Rolodex_Answer_Wait_Proc(TriggerType, EventInfo, CycleNumber)
PRIVATE Answer_Tbl, Menu_Tag, Return_Code
if (TriggerType = "ARRIVEFIELD") then
PROMPT Fld_Prompt[FIELD()]
RETURN 1
endif
if (EventInfo["TYPE"] = "MESSAGE") AND
(EventInfo["MESSAGE"] = "MENUSELECT") AND
(SUBSTR(EventInfo["MENUTAG"],1,2) = "R_") then
Menu_Tag = EventInfo["MENUTAG"]
SHOWPULLDOWN
ENDMENU
CLEARSPEEDBAR
MESSAGE "One moment please..."
ECHO OFF
SWITCH
CASE (Menu_Tag = "R_Envelope") :
FORMKEY
Print_Report(Subset_Table, "1", Rpt_St["Envelope"])
CASE (Menu_Tag = "R_Phone") OR (Menu_Tag = "R_Phone_Address") OR (Menu_Tag = "R_Rolodex") :
{Ask} TYPEIN Subset_Table ENTER
TAB CHECKPLUS EXAMPLE "LINK" TYPEIN "!"
{Ask} {Phone} CHECKPLUS TAB CHECK EXAMPLE "LINK"
DO_IT!
Answer_Tbl = PRIVDIR() + TABLE()
CLEARIMAGE ; erase answer image
MOVETO "Phone(Q)"
CLEARIMAGE ; erase 1st query image
MOVETO (Subset_Table + "(Q)")
CLEARIMAGE ; erase 2nd query image
if ISEMPTY(Answer_Tbl) then
No_Matches_Found()
else if (Menu_Tag = "R_Phone") then
COPYREPORT "Phone" "1" Answer_Tbl "R"
Print_Report(Answer_Tbl, "R", Rpt_St["Phone_Book"])
else if (Menu_Tag = "R_Phone_Address") then
COPYREPORT "Phone" "2" Answer_Tbl "R"
Print_Report(Answer_Tbl, "R", Rpt_St["Phone_Book"])
else COPYREPORT "Phone" "3" Answer_Tbl "R"
Print_Report(Answer_Tbl, "R", Rpt_St["Rolodex_Info"])
endif
endif
endif
ENDSWITCH
MOVETO Subset_Table
FORMKEY
ECHO NORMAL
EXECPROC "Rolodex_Answer_Menu"
RETURN 1
else Return_Code = Answer_Table_Wait_Proc(TriggerType, EventInfo, CycleNumber)
if (SYSMODE() = "Main") then
MENUENABLE "Assemble"
else MENUDISABLE "Assemble"
endif
RETURN Return_Code
endif
ENDPROC; Rolodex_Answer_Wait_Proc
PROC Ask_Rolodex()
; user selects rolodex records based on search criteria
PRIVATE Id, Last, Title, A1, A2, A3, City, Abrev, Zip, Group, Phone_No,
I, Form_List, Form_Num
MOVETO M_Tbl
Form_Num = FORM()
Id = [Id]
Last = ""
Title = ""
A1 = ""
A2 = ""
A3 = ""
City = ""
Abrev = ""
Zip = ""
Group = ""
Phone_No = ""
FORMKEY ; switch to table view
SHOWPULLDOWN ; hide rolodex main menu
ENDMENU
CLEARSPEEDBAR ; clear rolodex speedber
PROMPT "Enter selection criteria. Press Search to find matches, Cancel to quit."
MOUSE SHOW
SHOWDIALOG "Rolodex Selection Criteria"
@3, 15 HEIGHT 17 WIDTH 50
@1, 4 ?? "Id"
ACCEPT @1,15
WIDTH 25 "A80" PICTURE "*!"
TAG ""
TO Id
@2, 4 ?? "Last Name"
ACCEPT @2,15
WIDTH 25 "A80" PICTURE "*!"
TAG ""
TO Last
@3, 4 ?? "Group"
ACCEPT @3,15
WIDTH 25 "A45"
TAG ""
TO Group
@4, 4 ?? "Title"
ACCEPT @4,15
WIDTH 25 "A45" PICTURE "*!"
TAG ""
TO Title
@5, 4 ?? "Street 1"
ACCEPT @5,15
WIDTH 25 "A45"
TAG ""
TO A1
@6, 4 ?? "Street 2"
ACCEPT @6,15
WIDTH 25 "A45"
TAG ""
TO A2
@7, 4 ?? "Street 3"
ACCEPT @7,15
WIDTH 25 "A45"
TAG ""
TO A3
@8, 4 ?? "City"
ACCEPT @8,15
WIDTH 25 "A80" PICTURE "*!"
TAG ""
TO City
@9, 4 ?? "State"
ACCEPT @9,15
WIDTH 25 "A45" PICTURE "*!"
TAG ""
TO Abrev
@10, 4 ?? "Zip Code"
ACCEPT @10,15
WIDTH 25 "A45"
TAG ""
TO Zip
@11, 4 ?? "Phone No."
ACCEPT @11,15
WIDTH 25 "A45"
TAG ""
TO Phone_No
PUSHBUTTON @13,12 WIDTH 10
"~S~earch"
OK
DEFAULT
VALUE ""
TAG "OK"
TO Button
PUSHBUTTON @13,25 WIDTH 10
"~C~ancel"
CANCEL
VALUE ""
TAG "Cancel"
TO Button
ENDDIALOG
MOUSE HIDE
PROMPT ""
if (RetVal = True) then
MESSAGE "Searching..."
ECHO OFF
if NOT ISBLANK(Phone_No) then
{Ask} {Phone} TAB EXAMPLE "LINK" TAB TYPEIN Phone_No
{Ask} {Rolodex} Check TAB EXAMPLE "LINK" ; only 1 Id per phone #
if NOT ISBLANK(Id) then
TYPEIN ", "
endif
else {Ask} {Rolodex} CheckPlus
endif
[Id] = Id
[Title] = Title
[Last] = Last
[A1] = A1
[A2] = A2
[A3] = A3
[City] = City
[Abrev] = Abrev
[Zip] = Zip
[Group] = Group
DO_IT!
; if error in query form, abort selection process
if (TABLE() <> "Answer") then
; erase query image(s)
WHILE (IMAGETYPE() = "Query")
CLEARIMAGE
ENDWHILE
MESSAGE "Invalid selection criteria. Query unsuccessful."
FORMKEY
RETURN
endif
Subset_Table = PRIVDIR() + "SUBSET"
RENAME TABLE() Subset_Table
MOVETO "Rolodex(Q)" CLEARIMAGE ; erase rolodex query image
if NOT ISBLANK(Phone_No) then
MOVETO "Phone(Q)" CLEARIMAGE
endif
MOVETO Subset_Table
if ISEMPTY(Subset_Table) then
CLEARIMAGE
No_Matches_Found()
else ; copy form and display on screen
COPYFORM Main_Table Form_Num Subset_Table "1"
COPYREPORT Main_Table "1" Subset_Table "1"
View_Answer_Table(Subset_Table, 2, 2)
FORMTABLES Subset_Table "1" Form_List
FOR I FROM 1 to ARRAYSIZE(Form_List)
MOVETO Form_List[I]
IMAGERIGHTS READONLY ; make all detail records uneditable
ENDFOR
MOVETO Subset_Table
Rolodex_Answer_Wait()
if ISTABLE(Subset_Table) then ; delete subset table
ECHO OFF
DELETE(Subset_Table)
endif
endif
endif
FORMKEY ; return to form view
ENDPROC; Ask_Rolodex
PROC Rolodex_Answer_Menu()
SHOWPULLDOWN
"Modify" : "Toggle between edit and main mode" : "Modify"
SUBMENU
"Edit Mode - F9" : "Allow data to be edited, deleted, etc." : "Edit\Mode",
"Main Mode - F2" : "Discontinue editing" : "Main\Mode"
ENDSUBMENU,
"Reports" : "Choose report to generate" : "Reports"
SUBMENU
"Envelope" : "Create an envelope" : "R_Envelope",
"Phone Book" : "Generate list of phone numbers & addresses" : ""
SUBMENU
"Address & Phone #" : "List address & phone numbers" : "R_Phone_Address",
"Phone # Only" : "List only names & phone numbers" : "R_Phone"
ENDSUBMENU,
"Rolodex Info" : "All info in rolodex" : "R_Rolodex"
ENDSUBMENU,
"Assemble" : "Combine data and forms into documents" : "Assemble",
"Quit" : "Return to previous menu" : ""
SUBMENU
"No " : "Continue working with selected data" : "Return\No",
"Yes - F8" : "Return to complete data set" : "Return\Yes"
ENDSUBMENU
ENDMENU
if (SYSMODE() = "Main") then
MENUDISABLE "Main\Mode"
else MENUDISABLE "Edit\Mode"
MENUDISABLE "Reports"
MENUDISABLE "Assemble"
endif
Rolodex_Speedbar()
ENDPROC; Rolodex_Answer_Menu
PROC Rolodex_Answer_Wait()
Rolodex_Answer_Menu()
Sound_Off()
ECHO NORMAL
Message_Box("Search Completed", "Matching Rolodex Entries: " + STRVAL(NRECORDS(Subset_Table)))
WAIT WORKSPACE
PROC "Rolodex_Answer_Wait_Proc"
MESSAGE "MENUSELECT"
TRIGGER "ARRIVEFIELD"
KEY -60, -66, -67, -83, -50
; DO_IT Clear Edit Delete Alt-M
; F2 F8 F9 DEL Memo
ENDWAIT
CLEARSPEEDBAR
MESSAGE ""
ENDPROC; Rolodex_Answer_Wait
PROC Rolodex_Wait_Proc(TriggerType, EventInfo, CycleNumber)
PRIVATE Key_Code, Menu_Pick
if (TriggerType = "ARRIVEFIELD") then
PROMPT Fld_Prompt[FIELD()]
RETURN 1
endif
if (EventInfo["TYPE"] = "KEY") then
Key_Code = EventInfo["KEYCODE"]
SWITCH
; F9 - COEDIT
CASE (Key_Code = -67) : RETURN Main_Table_Edit()
; F2 - DO_IT!
CASE (Key_Code = -60) : if ISEMPTY(Main_Table) then
RETURN Main_Table_Clear()
else RETURN Main_Table_End_Edit()
endif
; F8 - CLEAR
CASE (Key_Code = -66) : RETURN Main_Table_Clear()
; Alt-M - Memo
CASE (Key_Code = -50) : Display_Memo(Main_Table)
Main_Table_Menu()
Rolodex_Speedbar()
RETURN 1
; DELETE
CASE (Key_Code = -83) : if (SYSMODE() = "CoEdit") then
RETURN Display_Delete_Box()
else RETURN 1
endif
; ALT-F - Switch form
CASE (Key_Code = -33) : if (SYSMODE() = "Main") then
ECHO OFF
MOVETO M_Tbl
if (FORM() = "1") then
PICKFORM 4
else if (FORM() = "4") then
PICKFORM 1
endif
endif
ECHO NORMAL
endif
RETURN 1
OTHERWISE : SOUND 400 100 RETURN 1
ENDSWITCH
endif
if (EventInfo["MESSAGE"] = "MENUSELECT") then
Menu_Pick = EventInfo["MENUTAG"]
SWITCH
CASE (Menu_Pick = "Edit\Mode") : RETURN Main_Table_Edit()
CASE (Menu_Pick = "Main\Mode") : if ISEMPTY(Main_Table) then
RETURN Main_Table_Clear()
else RETURN Main_Table_End_Edit()
endif
CASE (Menu_Pick = "Ask") : Ask_Rolodex()
Main_Table_Menu()
Rolodex_Speedbar()
RETURN 1
CASE (Menu_Pick = "Close\Yes") : RETURN Main_Table_Clear()
CASE (Menu_Pick = "Close\No") : RETURN 1
OTHERWISE : SOUND 400 100 RETURN 1
ENDSWITCH
endif
SOUND 400 100 RETURN 1 ; safety valve
ENDPROC; Rolodex_Wait_Proc
PROC Rolodex_Speedbar()
CLEARSPEEDBAR
SPEEDBAR "~F10~ Menu":-68, "~Alt-M~ Memo":-50
if ISASSIGNED(Fld_Prompt[FIELD()]) then
PROMPT Fld_Prompt[FIELD()]
else PROMPT ""
endif
ENDPROC; Rolodex_Speedbar
; MAIN PROCEDURE BEGINS HERE
Answer_Menu = "Rolodex_Answer_Menu"
DYNARRAY Fld_Prompt[]
Fld_Prompt["Id"] = "Unique key to identify & sort rolodex (required)"
Fld_Prompt["Last"] = "Last name or company name"
Fld_Prompt["Prefix"] = "Appropriate title, e.g. Mr., Ms., Dr., etc."
Fld_Prompt["First"] = "First name of individual(s)"
Fld_Prompt["Middle"] = "Middle name or initial"
Fld_Prompt["Suffix"] = "Appropriate title, e.g. Jr., Sr., M.D., etc."
Fld_Prompt["Group"] = "Press F1 to select group for this entry"
Fld_Prompt["Title"] = "Official title or postion, e.g. President"
Fld_Prompt["A1"] = "First line of address, or firm name"
Fld_Prompt["A2"] = "Second line of address"
Fld_Prompt["A3"] = "Third line of address"
Fld_Prompt["City"] = "City of mailing address"
Fld_Prompt["Abrev"] = "Press F1 to select two letter state abbreviation."
Fld_Prompt["Zip"] = "Zip code, 5 or 9 digits"
Fld_Prompt["Email"] = "Email address"
Fld_Prompt["DOB"] = "Date of Birth: ##/##/##"
Fld_Prompt["SS#"] = "Social Security No.: ###-##-###"
Fld_Prompt["Legal_Status"] = "Petitioner/Respondent, etc."
Fld_Prompt["Memo"] = "Add or edit notes for this rolodex entry"
Fld_Prompt["Location"] = "Location for phone no., e.g. Office, Home, etc."
Fld_Prompt["Phone"] = "Phone # formats: ###-####, 1-###-###-####"
Fld_Prompt["Identifier"] = "Name of variable"
Fld_Prompt["Response"] = "Text to replace variable"
Main_Table_View(M_Tbl, 2, 2)
Rolodex_Speedbar()
ECHO NORMAL
WAIT WORKSPACE
PROC "Rolodex_Wait_Proc"
MESSAGE "MENUSELECT"
TRIGGER "ARRIVEFIELD"
KEY -60, -66, -67, -83, -50, -33
; DO_IT Clear Edit Delete Alt-M Alt-F
; F2 F8 F9 DEL Memo Switch form
ENDWAIT
CLEARSPEEDBAR
PROMPT ""
MESSAGE ""
ENDPROC
WRITELIB Off_Lib Rolodex_Wait
RELEASE PROCS ALL

BIN
old-database/ROLODEX.SC2 Executable file
View File

Binary file not shown.

212
old-database/SETUP.SC Executable file
View File

@@ -0,0 +1,212 @@
MESSAGE "Writing setup table procedures to library..."
PROC CLOSED Setup_Table_Wait(Tbl, R, C, F_Num)
USEVARS Autolib, Main_Table, Rpt_St
PRIVATE Fld_Prompt
DYNARRAY Fld_Prompt[]
PROC Setup_Speedbar()
SPEEDBAR "~F10~ Menu":-68
if ISASSIGNED(Fld_Prompt[FIELD()]) then
PROMPT Fld_Prompt[FIELD()]
else PROMPT
endif
ENDPROC;
PROC Setup_Table_Menu()
SHOWPULLDOWN
"Modify" : "Toggle between edit and main mode" : "Modify"
SUBMENU
"Edit Mode - F9" : "Allow data to be edited, deleted, etc." : "Edit\Mode",
"Main Mode - F2" : "Discontinue editing" : "Main\Mode"
ENDSUBMENU,
"Reports" : "Choose report to generate" : "Reports"
SUBMENU
"Print All" : "Report on all records in this table" : "R_Standard",
"Cancel" : "Do not print any report" : "R_Cancel"
ENDSUBMENU,
"Return" : "Return to previous menu" : ""
SUBMENU
"No " : "Continue working with this data" : "Return\No",
"Yes - F8" : "Return to main menu" : "Return\Yes"
ENDSUBMENU
ENDMENU
if ISEMPTY(Tbl) then
Edit_Mode()
else MENUDISABLE "Main\Mode"
endif
ENDPROC
PROC Setup_Table_Wait_Proc(TriggerType, EventInfo, CycleNumber)
PRIVATE Key_Code, Menu_Pick
if (TriggerType = "ARRIVEFIELD") then
Setup_Speedbar()
RETURN 1
endif
if (EventInfo["TYPE"] = "MESSAGE") then
Menu_Pick = EventInfo["MENUTAG"]
SWITCH
CASE (Menu_Pick = "Edit\Mode") : RETURN Edit_Mode()
CASE (Menu_Pick = "Main\Mode") : if ISEMPTY(Tbl) then
RETURN Clear_Table()
else RETURN Main_Mode()
endif
CASE (Menu_Pick = "R_Standard") : ECHO OFF
Print_Report(Main_Table, "1", "")
Setup_Table_Menu()
Setup_Speedbar()
RETURN 1
CASE (Menu_Pick = "R_Cancel") : RETURN 1
CASE (Menu_Pick = "Return\Yes") : RETURN Clear_Table()
CASE (Menu_Pick = "Return\No") : RETURN 1
OTHERWISE : SOUND 400 100 RETURN 1
ENDSWITCH
endif
if (EventInfo["TYPE"] = "KEY") then
Key_Code = EventInfo["KEYCODE"]
SWITCH
; F3 or F4 UPIMAGE, DOWNIMAGE
CASE (Key_Code = -61) OR
(Key_Code = -62) : if (NIMAGES() > 1) then
RETURN 0
else RETURN 1
endif
; F9 - COEDIT
CASE (Key_Code = -67) : RETURN Edit_Mode()
; F2 - DO_IT!
CASE (Key_Code = -60) : if (SYSMODE() = "CoEdit") and (Tbl = "Deposits") then
ECHO OFF
MOVETO "Payments"
MOVETO FIELD "Amount"
Balance = IMAGECSUM()
MOVETO "Deposits"
[Total] = Balance
ECHO NORMAL
endif
if ISEMPTY(Tbl) then
RETURN Clear_Table()
else RETURN Main_Mode()
endif
; + to add one day to current date
CASE (Key_Code = 43) : RETURN Change_Date(43)
; - to subtract one day from current date
CASE (Key_Code = 45) : RETURN Change_Date(45)
; DELETE
CASE (Key_Code = -83) : if (SYSMODE() = "CoEdit") then
RETURN Display_Delete_Box()
else RETURN 1
endif
; F8 - CLEAR
CASE (Key_Code = -66) : RETURN Clear_Table()
OTHERWISE : SOUND 400 100 RETURN 1
ENDSWITCH
endif
SOUND 400 100 RETURN 1
ENDPROC;
; main body of procedure follows
SWITCH
CASE (Tbl = "PlanInfo") :
Fld_Prompt["Plan_Name"] = "Full name of plan:"
Fld_Prompt["Plan_Id"] = "Unique plan ID code:"
Fld_Prompt["Plan_Type"] = "Type of plan (DB,DC):"
Fld_Prompt["Divisible"] = "Means by which this Plan may be divided, if any?"
Fld_Prompt["Drafted"] = "Has a QDRO been drafted for this Plan?"
Fld_Prompt["Memo"] = "Description of plan particulars:"
CASE (Tbl = "Inx_Lkup") :
Fld_Prompt["Keyword"] = "Unique keyword to index form"
CASE (Tbl = "RVarLkup") OR (Tbl = "FVarLkup"):
Fld_Prompt["Identifier"] = "Name of variable as placed in forms"
Fld_Prompt["Query"] = "Query used to solicit response"
CASE (Tbl = "Deposits") :
Fld_Prompt["Deposit_Date"] = "Enter date of deposit"
Fld_Prompt["Total"] = "Enter total amount of deposit"
Fld_Prompt["File_No"] = "File number related to this payment"
Fld_Prompt["Id"] = "Id of file owner from rolodex"
Fld_Prompt["Regarding"] = "Description of pertinent matter"
Fld_Prompt["Amount"] = "Amount of payment to this account"
Fld_Prompt["Note"] = "Additional notation for this payment"
CASE (Tbl = "FileType") :
Fld_Prompt["File_Type"] = "Unique area of law"
CASE (Tbl = "Employee") :
Fld_Prompt["Empl_Num"] = "Unique employee number"
Fld_Prompt["Empl_Id"] = "Employee ID from Rolodex"
Fld_Prompt["Rate_Per_Hour"] = "Default billing rate"
CASE (Tbl = "TrnsType") :
Fld_Prompt["T_Type"] = "Unique code to group transactions"
Fld_Prompt["T_Type_L"] = "Letter describing transaction group"
Fld_Prompt["Header"] = "Header in statement for this group"
Fld_Prompt["Footer"] = "Footer in statement for this group"
CASE (Tbl = "Footers") :
Fld_Prompt["F_Code"] = "Unique code for this footer"
Fld_Prompt["F_Footer"] = "Text of footer at end of statement"
CASE (Tbl = "GrupLkup") :
Fld_Prompt["Code"] = "Unique code for this rolodex group"
Fld_Prompt["Description"] = "Description of this rolodex group"
Fld_Prompt["Title"] = "Default title to fill in in rolodex"
CASE (Tbl = "TrnsLkup") :
Fld_Prompt["T_Code"] = "Unique code for this transaction"
Fld_Prompt["T_Type"] = "Accounting group for this transaction"
Fld_Prompt["T_Type_L"] = "Letter describing transaction's group"
Fld_Prompt["Description"] = "Description of transaction in statement"
Fld_Prompt["Amount"] = "Default amount for this transaction type"
CASE (Tbl = "FileStat") :
Fld_Prompt["Status"] = "Unique status to assign files"
Fld_Prompt["Definition"] = "Definition for files of this status"
Fld_Prompt["Send"] = "Should these statements be printed normally?"
Fld_Prompt["Footer_Code"] = "Default statement footer for these files"
CASE (Tbl = "States") :
Fld_Prompt["Abrev"] = "Two letter state abbreviation"
Fld_Prompt["St"] = "Full name of state"
CASE (Tbl = "Printers") :
Fld_Prompt["Number"] = "Unique number for this printer setup"
Fld_Prompt["Name"] = "Name of this printer or setup"
Fld_Prompt["Page_Break"] = "Page break method"
Fld_Prompt["Port"] = "Direct output to this port"
Fld_Prompt["Phone_Book"] = "Setup string for phone book report"
Fld_Prompt["Rolodex_Info"] = "Setup string for rolodex report"
Fld_Prompt["Envelope"] = "Setup string for envelope report"
Fld_Prompt["File_Cabinet"] = "Setup string for file cabinet report"
Fld_Prompt["Accounts"] = "Setup string for account summary reports"
Fld_Prompt["Statements"] = "Setup string for all statements"
Fld_Prompt["Calendar"] = "Setup string for calendar report"
Fld_Prompt["Setup_St"] = "Generic setup string for all reports"
Fld_Prompt["Reset_St"] = "Printer Reset string"
Fld_Prompt["B_Underline"] = "Begin underlining"
Fld_Prompt["E_Underline"] = "Terminate underlining"
Fld_Prompt["B_Bold"] = "Begin bold"
Fld_Prompt["E_Bold"] = "Terminate bold"
ENDSWITCH
ECHO OFF
VIEW Tbl
if (Tbl = "Deposits") then
END
endif
Setup_Table_Menu()
WINDOW MOVE GETWINDOW() TO -100, -100
PICKFORM F_Num
WINDOW HANDLE CURRENT TO Form_Win
DYNARRAY Win_Atts[]
Win_Atts["ORIGINROW"] = R
Win_Atts["ORIGINCOL"] = C
Win_Atts["CANMOVE"] = False
Win_Atts["CANRESIZE"] = False
Win_Atts["CANCLOSE"] = False
WINDOW SETATTRIBUTES Form_Win FROM Win_Atts
ECHO NORMAL
Setup_Speedbar()
WAIT WORKSPACE
PROC "Setup_Table_Wait_Proc"
MESSAGE "MENUSELECT"
TRIGGER "ARRIVEFIELD"
KEY -60, -66, -83, -67, -61, -62, 43, 45
; DO_IT Clear Delete Edit UpIm DwnIm + -
; F2 F8 DEL F9 F3 F4 Next Prev day
ENDWAIT
CLEARSPEEDBAR
MESSAGE ""
PROMPT ""
ENDPROC
WRITELIB Off_Lib Setup_Table_Wait
RELEASE PROCS ALL

BIN
old-database/SETUP.SC2 Executable file
View File

Binary file not shown.

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

BIN
old-database/UTILITY.SC2 Executable file
View File

Binary file not shown.