621 lines
16 KiB
Plaintext
Executable File
621 lines
16 KiB
Plaintext
Executable File
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 |