397 lines
12 KiB
Scala
Executable File
397 lines
12 KiB
Scala
Executable File
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 |