Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : STRALEY.ZIP
Filename : CALL.PRG

********************
* Name CALL.prg
* Date August 15, 1986
* Notice Copyright 1986, Stephen J. Straley
* Note This application was generated by GENCODE.
*
********************

CLEAR
? "Loading Program..."
DO Beginit
DO Draw
DO Camenu

********************

PROCEDURE Beginit

IF .NOT. FILE("SCREEN.SYS")
DO Scrinit
ENDIF
RESTORE FROM Screen.sys
IF .NOT. FILE(scrdata + "LOG_CALL.DBF") .OR. .NOT. FILE(scrdata + "CONTRACT.DBF")
DO Cainit
ENDIF

********************

PROCEDURE Scrinit


SET SCOREBOARD OFF

CLEAR
scrframe = CHR(201) + CHR(205) + CHR(187) + CHR(186) + CHR(188) + ;
CHR(205) + CHR(200) + CHR(186) + CHR(32)
scrleft_1 = "Copyright 1986 - GLOBAL SOFTWARE"
scrleft_2 = "All Rights Reserved"
right_1 = "Terminal/System Setup Program"
right_2 = "May - 1986"
temscreen = SPACE(4000)
center = "Drive Assignment Setup"
@ 0,0 SAY scrleft_1
@ 1,0 SAY scrleft_2
@ 0,80-LEN(right_1) SAY right_1
@ 1,80-LEN(right_2) SAY right_2
@ 3,40-LEN(center)/2 SAY center
@ 4,0,23,79 BOX SUBSTR(scrframe, 1, 8)
topspot = " Move cursor to appropriate option. Strike RETURN key to change "
@ 5, 1 GET topspot
CLEAR GETS
@ 6, 0 SAY CHR(204) + REPLICATE(CHR(205),78) + CHR(185)
CALL _scrsave WITH temscreen
IF .NOT. FILE("SCREEN.SYS")
STORE "C:" TO scrprog, scrdata
STORE .F. TO scrconfirm, scrdelim, scrcolor, scrinten, scrbell, scrtype
STORE .T. TO scrsys, scrshow
STORE "" TO scrframe, scrbar, scrlin
STORE "::" TO scrdelimto
STORE 0 TO scrtimes, scrpass
ELSE
RESTORE FROM Screen.sys ADDITIVE
ENDIF
STORE 4 TO option

DO WHILE .T.
CALL _scrrest WITH temscreen
@ 7, 5 PROMPT " 1> System Configured for " + IF(scrsys, "Hard", "Floppy") + " Disk "
@ 7,45 PROMPT " 2> Program Drive Set to " + scrprog + " "
@ 8,45 PROMPT " 3> Data Drive Set to " + scrdata + " "
@ 10, 5 PROMPT " 4> Confirm is " + IF(scrconfirm, "ON ", "OFF") + " "
@ 11, 5 PROMPT " 5> Delimiters are " + IF(scrdelim, "ON", "OFF") + " "
@ 12, 5 PROMPT " 6> Delimiters SET to " + scrdelimto + " "
@ 13, 5 PROMPT " 7> Screen " + IF(scrcolor, "Bright", "Normal") + " "
@ 14, 5 PROMPT " 8> Field Color is " + IF(scrinten, "ON", "OFF") + " "
@ 15, 5 PROMPT " 9> Bell " + IF(scrbell, "WILL", "WILL NOT") + " ring "
@ 10,40 PROMPT " A> Password " + IF(scrshow, "WILL", "WILL NOT") + " echo to screen "
@ 12,40 PROMPT " B> Change Password "
@ 14,40 PROMPT " C> " + DLTRIM(STR(scrtimes)) + " tries at the Password "
@ 16,40 PROMPT " D> " + IF(scrtype, "Engage", "Disengage") + " Type-Ahead Feature "
@ 18,33 SAY " to Save Values"
MENU TO option
DO CASE
CASE option = 1
scrsys = IF(scrsys, .F., .T.)
IF .NOT. scrsys
KEYBOARD "2"
ENDIF
CASE option = 2
@ 21,10 SAY "Enter Program Drive: " GET scrprog PICT "!" VALID(SUBSTR(scrprog,1,1) $"ABCDEFGHIJKLMNOP")
READ
IF .NOT. scrsys
IF scrprog = scrdata
@ 21,10 SAY SPACE(50)
@ 22,10 SAY "Data Drive and Program Drive NOT EQUAL for Floppy System"
@ 21,10 SAY "Enter Data Drive: " GET scrdata PICT "!" VALID(SUBSTR(scrdata,1,1) $"ABCDEFGHIJKLMNOP" .AND. scrprog <> scrdata)
READ
ENDIF
ENDIF
CASE option = 3
@ 21,10 SAY "Enter Data Drive: " GET scrdata PICT "!" VALID(SUBSTR(scrdata,1,1) $"ABCDEFGHIJKLMNOP")
READ
IF .NOT. scrsys
IF scrprog = scrdata
@ 21,10 SAY SPACE(50)
@ 22,10 SAY "Program Drive and Data Drive NOT EQUAL for Floppy System"
@ 21,10 SAY "Enter Program Drive: " GET scrprog PICT "!" VALID(SUBSTR(scrprog,1,1) $"ABCDEFGHIJKLMNOP" .AND. scrdata <> scrprog)
ENDIF
ENDIF
CASE option = 4
scrconfirm = IF(scrconfirm, .F., .T.)
CASE option = 5
scrdelim = IF(scrdelim, .F., .T.)
CASE option = 6
STORE " " TO choice
@ 21,10 SAY "Set Left Delimiter: " GET choice PICT "X"
READ
STORE choice TO scrdelimto
STORE " " TO choice
@ 21,10 SAY "Set Right Delimiter: " GET choice PICT "X"
READ
STORE scrdelimto + choice TO scrdelimto
CASE option = 7
scrcolor = IF(scrcolor, .F., .T.)
CASE option = 8
scrinten = IF(scrinten, .F., .T.)
CASE option = 9
scrbell = IF(scrbell, .F., .T.)
CASE option = 10
scrshow = IF(scrshow, .F., .T.)
CASE option = 11
STORE SPACE(15) TO password
@ 21,10 SAY "What Password do you want to use? " GET password PICT "XXXXXXXXXXXXXXX"
READ
scrpass = GENPASS(password)
CASE option = 12
@ 21,10 SAY "How may tries for a correct password? " GET scrtimes PICT "##" range 0,99
READ
CASE option = 13
scrtype = IF(scrtype, .F., .T.)
OTHERWISE
EXIT
ENDCASE
ENDDO

CALL _scrrest WITH temscreen
@ 3,3 SAY SPACE(60)
@ 3,29 SAY "Installing the Border"
CALL _scrsave WITH temscreen
in_choice = 4
prmpt_4 = CHR(201) + CHR(205) + CHR(187) + CHR(186) + ;
CHR(188) + CHR(205) + CHR(200) + CHR(186) + CHR(32)
prmpt_5 = REPLICATE(CHR(177), 8) + " "
prmpt_6 = CHR(218) + CHR(196) + CHR(191) + CHR(179) + ;
CHR(217) + CHR(196) + CHR(192) + CHR(179) + CHR(32)
prmpt_7 = CHR(222) + CHR(223) + CHR(221) + CHR(221) + ;
CHR(221) + CHR(220) + CHR(222) + CHR(222) + CHR(32)
prmpt_9 = REPLICATE(CHR(15), 8) + " "

DO WHILE .T.
CALL _scrrest WITH temscreen
@ 8, 5 PROMPT "1> *********"
@ 8,32 PROMPT "2> ========="
@ 8,59 PROMPT "3> ---------"
@ 10, 5 PROMPT "4> &prmpt_4."
@ 10,32 PROMPT "5> &prmpt_5."
@ 10,59 PROMPT "6> &prmpt_6."
@ 12, 5 PROMPT "7> &prmpt_7."
@ 12,32 PROMPT "8> ùùùùùùùù "
@ 12,59 PROMPT "9> &prmpt_9."
@ 14,20 SAY "Move Cursor to choose preferred boarded"
MENU TO in_choice
DO CASE
CASE in_choice = 1
scrframe = "******** "
scrbar = REPLICATE("*",80)
scrlin = "*"
CASE in_choice = 2
scrframe = "======== "
scrbar = REPLICATE("=",80)
scrlin = "="
CASE in_choice = 3
scrframe = "-------- "
scrbar = REPLICATE("-",80)
scrlin = "|"
CASE in_choice = 4
scrframe = CHR(201) + CHR(205) + CHR(187) + CHR(186) + CHR(188) + ;
CHR(205) + CHR(200) + CHR(186) + CHR(32)
scrbar = CHR(204) + REPLICATE(CHR(205), 78) + CHR(185)
scrlin = CHR(186)
CASE in_choice = 5
scrframe = REPLICATE(CHR(177), 8) + " "
scrbar = REPLICATE(CHR(177),80)
scrlin = CHR(177)
CASE in_choice = 6
scrframe = CHR(218) + CHR(196) + CHR(191) + CHR(179) + CHR(217) + ;
CHR(196) + CHR(192) + CHR(179) + CHR(32)
scrbar = CHR(195) + REPLICATE(CHR(196), 78) + CHR(180)
scrlin = CHR(179)
CASE in_choice = 7
scrframe = CHR(222) + CHR(223) + CHR(221) + CHR(221) + CHR(221) + ;
CHR(220) + CHR(222) + CHR(222) + CHR(32)
scrbar = CHR(222) + REPLICATE(CHR(220),78) + CHR(221)
scrlin = CHR(222)
CASE in_choice = 8
scrframe = "ùùùùùùùù "
scrbar = REPLICATE("ù",80)
scrlin = "ù"
CASE in_choice = 9
scrframe = REPLICATE(CHR(15), 8) + " "
scrbar = REPLICATE(CHR(15), 80)
scrlin = CHR(15)
ENDCASE

CALL _scrrest WITH temscreen
@ 8,10,16,69 BOX SUBSTR(scrframe,1,8)
@ 12,10 SAY SUBSTR(scrbar,1,1) + SUBSTR(scrbar,2,58) + SUBSTR(scrbar,80,1)
@ 19,25 SAY "Is this the border you want? "
IF VERIFY()
EXIT
ENDIF
ENDDO

writefile = scrprog + "SCREEN.SYS"
@ 22,24 SAY "Now Saving parameters to " + writefile
SAVE ALL LIKE scr* TO &writefile
CALL _scrrest WITH temscreen
@ 12,18 SAY "Finished with Terminal/System Initialization"
IF INKEY(.5) = 32
RETURN
ENDIF

********************

PROCEDURE Draw


CLEAR
RESTORE FROM SCREEN.SYS additive
IF scrcolor
SET COLOR TO 7+
ELSE
SET COLOR TO 7
ENDIF
@ 3,20,7,60 BOX scrframe
@ 5,28 SAY " GLOBAL SOFTWARE "
@ 9,40-LEN("Call Tracking")/2 SAY "Call Tracking"
@ 21,11 SAY " Designed by Stephen J. Straley "

DO WHILE .T.
STORE "Today's Date is " + CDOW(DATE()) + ", " + CMON(DATE()) TO prompt
STORE prompt + " " + STR(DAY(DATE()),2) + ", " + STR(YEAR(DATE()),4) TO prompt
@ 14,40-LEN(prompt)/2 SAY prompt
@ 18,25 SAY "Is this the Correct Date? "
IF .NOT. VERIFY()
mdate = DATE()
@ 18, 0 SAY SPACE(80)
@ 18,28 SAY "Enter in Date: " GET mdate
READ
mdate = DTOC(mdate)
RUN DATE &mdate
@ 18,25 SAY SPACE(40)
ELSE
EXIT
ENDIF

ENDDO

********************

FUNCTION Dltrim


PARAMETER in_string

RETURN(LTRIM(TRIM(in_string)))

********************

FUNCTION Endfield


PARAMETER File

USE CALL.PRG
x = 1
y = 1024
z = INT(y/2)

DO WHILE x <> y
IF LEN(FIELDNAME(z)) = 0
y = z
ELSE
x = z
ENDIF
z = x + int((y-x)/2)
IF LEN(FIELDNAME(z)) > 0 .AND. LEN(FIELDNAME(z+1)) = 0
y = z
x = z
ENDIF
ENDDO
RETURN(y)


********************

FUNCTION Dayword


PARAMETER in_date

in_day = STR(DAY(in_date),2)
in_val = VAL(in_day)
IF in_val > 4 .AND. in_val < 21
in_day = in_day + "th"
ELSE
in_val = VAL(SUBSTR(in_day,2,1))
in_day = in_day + SUBSTR("thstndrdthththththth", (in_val * 2)+1,2)
ENDIF
RETURN(in_day)


********************

FUNCTION Expand


PARAMETER in_string

length = LEN(in_string)
counter = 1
out_str = ""

DO WHILE counter <= length
out_str = out_str + SUBSTR(in_string,counter,1) + " "
counter = counter + 1
ENDDO
RETURN(TRIM(out_str))


********************

FUNCTION Qwait


SET CONSOLE OFF
WAIT TO intemp
SET CONSOLE ON
IF UPPER(intemp) = "Q"
RETURN(.T.)
ENDIF
RETURN(.F.)


********************

FUNCTION Chkamt


PARAMETERS figure

final = ""
IF figure < 0
final = "Unable to Print"
RETURN(final)
ENDIF
cents = SUBSTR(STR(figure, 15, 2), 14, 2)
new = INT(figure)
********************
* check for BILLIONS
********************
temp = INT(new/1000000000)
IF temp > 0
final = final + GRP_EXPAND(temp) + " Billion "
new = new - (temp*1000000000)
ENDIF
********************
* check for MILLIONS
********************
temp = INT(new/1000000)
IF temp > 0
final = final + GRP_EXPAND(temp) + " Million "
new = new - (temp*1000000)
ENDIF
*********************
* check for THOUSANDS
*********************
temp = INT(new/1000)
IF temp > 0
final = final + GRP_EXPAND(temp) + " Thousand "
new = new - (temp*1000)
ENDIF
temp = new
*****************
* check for UNITS
*****************
IF temp > 0
final = final + GRP_EXPAND(temp)
ENDIF
IF SUBSTR(final,1,3) = "One" .AND. LEN(final) = 3
final = final + " Dollar and " + cents + "/100"
ELSE
final = final + " Dollars and " + cents + "/100"
ENDIF
RETURN(final)


********************

FUNCTION Grp_expand


PARAMETER group_val

one_unit = "One Two Three Four Five Six Seven Eight Nine Ten Eleven Twelve Thirteen Fourteen Fifteen Sixteen SeventeenEighteen Nineteen"
ten_unit = "Twenty Thirty Forty Fifty Sixty SeventyEighty Ninety "
group_str = ""
IF group_val > 99
new1 = INT(group_val/100)
group_str = group_str + TRIM(SUBSTR(one_unit,(new1*9)-8,9))
group_val = group_val - (new1 * 100)
group_str = group_str + " Hundred "
ENDIF
IF group_val > 19
new1 = INT(group_val/10)-1
group_str = group_str + TRIM(SUBSTR(ten_unit,(new1*7)-6,7))
new1 = INT(group_val/10)*10
group_val = group_val - new1
IF group_val > 0
group_str = group_str + "-"
ENDIF
ENDIF
IF group_val > 0
group_str = group_str + TRIM(SUBSTR(one_unit,(group_val*9)-8,9))
ENDIF
RETURN(group_str)


********************

FUNCTION Chktest


in_check = "Y"
@ 12,10 SAY "Would you like to print a test check? "
IF VERIFY()
RETURN(.T.)
ENDIF
RETURN(.F.)


********************

FUNCTION Verify

SET CONSOLE OFF
STORE "" TO inertemp
DO WHILE .NOT. inertemp$"YyNn"
WAIT TO inertemp
ENDDO
SET CONSOLE ON
IF UPPER(inertemp) = "Y"
?? "Yes"
te = INKEY(.25)
RETURN(.T.)
ENDIF
?? "No "
te = INKEY(.25)
RETURN(.F.)


********************

FUNCTION Prntpage


PARAMETERS normal

IF normal
@ 63,35 SAY "Page"
@ PROW(),PCOL()+2 SAY page PICT "@B"
@ 64,0 SAY ""
ELSE
@ 63,65 SAY "Page"
@ PROW(),PCOL()+2 SAY page PICT "@B"
@ 64,0 SAY ""
ENDIF
RETURN(page)


********************

FUNCTION Signchng


PARAMETERS amount

IF amount >= 0
RETURN (STR(amount))
ENDIF
amount = amount * -1
newfig = "(" + TRIM(LTRIM(STR(amount,15,2))) + ")"
newfig = SPACE(16 - LEN(newfig)) + newfig
RETURN(newfig)


********************

FUNCTION Prntdate


PARAMETERS in_date

out_date = CDOW(in_date) + ", " + "the " + DAYWORD(in_date) + " of " + CMON(in_date) + ", " + STR(YEAR(in_date),4)
RETURN(out_date)


********************

FUNCTION Checking


IF EOF() .OR. BOF()
@ 22,8 SAY "Can not continue past end. Press any key to return to the menu."
te = INKEY(0)
RETURN(.T.)
ENDIF
RETURN(.F.)


********************

FUNCTION Genpass


PARAMETERS in_string

count = LEN(TRIM(in_string))
final = 0
FOR beginning = 1 to (count + 1)
final = final + ASC(SUBSTR(in_string,beginning,1)) * beginning
NEXT
RETURN(final)


********************

FUNCTION Chkpass


PARAMETERS row, col

IF scrtimes = 0
RETURN(.T.)
ENDIF
IF scrshow
SET COLOR TO 7/0, 0/7
ELSE
SET COLOR TO 7+/0, 0+/0
ENDIF
FOR x = 1 to scrtimes
in_pass = SPACE(15)
@ row-3,col-5,row+3,col+34 BOX scrframe
@ row,col SAY "Password --> " GET in_pass PICT "XXXXXXXXXXXXXXX"
READ
IF LEN(TRIM(in_pass)) <> 0
temp_count = GENPASS(in_pass)
IF temp_count = scrpass
x = 1000
ENDIF
ENDIF
NEXT
IF scrcolor
SET COLOR TO 7+/0, 0/7
ELSE
SET COLOR TO 7/0, 0/7
ENDIF
IF scrinten
SET INTEN ON
ELSE
SET INTEN OFF
ENDIF
RETURN(x > 101)


********************

FUNCTION Roundit


PARAMETERS in_amount

in_amount = INT(in_amount * 100 + .5) / 100.00
RETURN(in_amount)




********************

FUNCTION Printdate


PARAMETERS in_date, whichone

DO CASE
CASE whichone = 1
out_str = CMONTH(in_date) + " " + DAYWORD(in_date) + ", " + DLTRIM(STR(YEAR(in_date)))
CASE whichone = 2
out_str = CDOW(in_date) + ", the " + DAYWORD(in_date) + " of " + CMONTH(in_date) + ", " + dltrim(STR(YEAR(in_date)))
CASE whichone = 3
out_str = CDOW(in_date) + ", the " + DAYWORD(in_date) + " of " + CMONTH(in_date)
CASE whichone = 4
out_str = "The " + DAYWORD(in_date) + " of " + CMONTH(in_date) + ", " + DLTRIM(STR(YEAR(in_date)))
CASE whichone = 5
out_str = CDOW(in_date) + ", " + CMON(in_date) + " "
out_str = out_str + STR(DAY(in_date),2) + ", " + STR(YEAR(in_date),4)
OTHERWISE
out_str = DTOC(in_date)
ENDCASE
RETURN(out_str)

********************

PROCEDURE Typeahead


IF !scrtype
CALL _cclr
ENDIF

********************

PROCEDURE Blink


PARAMETERS temp_row, temp_col

IF scrcolor
SET COLOR TO W*+
ELSE
SET COLOR TO W*
ENDIF
@ temp_row, temp_col SAY "Deleted Record"
IF scrcolor
SET COLOR TO W+
ELSE
SET COLOR TO W
ENDIF



********************

PROCEDURE Setup


SET FUNCTION 2 TO CHR(22)
SET FUNCTION 3 TO CHR(1)
SET FUNCTION 4 TO CHR(6)
SET FUNCTION 5 TO CHR(3)
SET FUNCTION 6 TO CHR(5)
SET FUNCTION 8 TO CHR(23)
SET FUNCTION 7 TO CHR(20)
SET FUNCTION 9 TO CHR(25)
SET FUNCTION 10 TO CHR(21)
IF scrinten
SET INTENS on
ELSE
SET INTENS off
ENDIF
IF scrdelim
SET DELIM TO "&scrdelimto"
SET DELIM on
ELSE
SET DELIM off
ENDIF
IF scrconfirm
SET CONFIRM on
ELSE
SET CONFIRM off
ENDIF
IF scrbell
SET BELL on
ELSE
SET BELL off
ENDIF
IF scrcolor
SET COLOR TO 7+
ELSE
SET COLOR TO 7
ENDIF


********************

PROCEDURE Redraw


PARAMETERS center
@ 1,0 say scrleft_1
@ 2,0 say scrleft_2
@ 1,80-LEN("Generic Application") SAY "Generic Application"
@ 2,80-LEN("Version 1.00") SAY "Version 1.00"
@ 4,40-LEN(center)/2 SAY center


********************

PROCEDURE Whichway


PARAMETERS file, way, d, c

way = 1
@ d,c,d + 5, c + 40 BOX scrframe
@ d + 1, c + 10 PROMPT " 1> Print to Screen "
@ d + 2, c + 10 PROMPT " 2> Print to Printer "
@ d + 3, c + 10 PROMPT " 3> Print to File "
@ d + 4, c + 10 SAY " ESC to RETURN"
MENU TO way
IF way = 3
FOR fortemp = d + 1 TO d + 4
@ fortemp, c + 5 SAY SPACE(30)
NEXT
@ d + 1, c + 10 SAY "Enter File Name: "
@ d + 3, c + 10 SAY "-> " GET file PICT "@X"
READ
IF LEN(TRIM(file)) = 0
way = 0
ENDIF
IF AT(".",file) = 0
file = TRIM(SUBSTR(file,1,8)) + ".TXT"
ENDIF
ENDIF

********************

PROCEDURE Cainit


DO Cainthd
DO Cainit1
DO Cainit2

@ 12, 6 SAY "All Files/Indexes have been properly created. Any Key to Continue..."
qw = INKEY(0)
CLOSE DATABASES
@ 12, 2 SAY SPACE(70)

********************

PROCEDURE Cainit1


SELECT 9
@ 6, 5 SAY "Initializing CONTRACT File"
CREATE Template
USE Template
APPEND BLANK
REPLACE field_name WITH "IN_DATE", field_type WITH "D", field_len WITH 8, field_dec WITH 0
APPEND BLANK
REPLACE field_name WITH "SUPPORT_NO", field_type WITH "N", field_len WITH 6, field_dec WITH 0
APPEND BLANK
REPLACE field_name WITH "COMPUTER", field_type WITH "C", field_len WITH 10, field_dec WITH 0
APPEND BLANK
REPLACE field_name WITH "OP_SYSTEM", field_type WITH "C", field_len WITH 3, field_dec WITH 0
APPEND BLANK
REPLACE field_name WITH "PURCHASED", field_type WITH "C", field_len WITH 20, field_dec WITH 0
APPEND BLANK
REPLACE field_name WITH "SERIAL_NO", field_type WITH "C", field_len WITH 8, field_dec WITH 0
APPEND BLANK
REPLACE field_name WITH "PAYMENT_M", field_type WITH "C", field_len WITH 10, field_dec WITH 0
APPEND BLANK
REPLACE field_name WITH "PAYMENT_A", field_type WITH "N", field_len WITH 6, field_dec WITH 2
APPEND BLANK
REPLACE field_name WITH "EXPIRES", field_type WITH "C", field_len WITH 5, field_dec WITH 0
APPEND BLANK
REPLACE field_name WITH "END_OF_SUP", field_type WITH "D", field_len WITH 8, field_dec WITH 0
APPEND BLANK
REPLACE field_name WITH "COMPANY", field_type WITH "C", field_len WITH 30
APPEND BLANK
REPLACE field_name WITH "NAME", field_type WITH "C", field_len WITH 25
APPEND BLANK
REPLACE field_name WITH "ADDRESS_1", field_type WITH "C", field_len WITH 25
APPEND BLANK
REPLACE field_name WITH "ADDRESS_2", field_type WITH "C", field_len WITH 25
APPEND BLANK
REPLACE field_name WITH "CITY", field_type WITH "C", field_len WITH 20
APPEND BLANK
REPLACE field_name WITH "STATE", field_type WITH "C", field_len WITH 2
APPEND BLANK
REPLACE field_name WITH "ZIP", field_type WITH "C", field_len WITH 5
APPEND BLANK
REPLACE field_name WITH "PHONE_NO", field_type WITH "C", field_len WITH 21
USE
CREATE &scrdata.CONTRACT FROM Template
USE &scrdata.CONTRACT
ERASE Template
@ 6, 5 SAY SPACE(70)
@ 7, 5 SAY "Creating Support Number Index"
temp = scrdata + "CONTRA_1.DAT"
INDEX ON support_no TO &temp
@ 7, 2 SAY SPACE(70)
@ 8, 5 SAY "Creating Phone Number Index"
temp = scrdata + "CONTRA_2.DAT"
INDEX ON phone_no TO &temp
@ 8, 2 SAY SPACE(70)
@ 9, 5 SAY "Creating Company Name Index"
temp = scrdata + "CONTRA_3.DAT"
INDEX ON company TO &temp
@ 9, 2 SAY SPACE(70)

********************

PROCEDURE Cainit2


SELECT 9
@ 10, 5 SAY "Initializing LOG_CALL File"
CREATE Template
USE Template
APPEND BLANK
REPLACE field_name WITH "CONTROL_NO", field_type WITH "N", field_len WITH 6, field_dec WITH 0
APPEND BLANK
REPLACE field_name WITH "CATEGORY", field_type WITH "N", field_len WITH 1, field_dec WITH 0
APPEND BLANK
REPLACE field_name WITH "DATE_IN", field_type WITH "D", field_len WITH 8, field_dec WITH 0
APPEND BLANK
REPLACE field_name WITH "WEEK_IN", field_type WITH "N", field_len WITH 2, field_dec WITH 0
APPEND BLANK
REPLACE field_name WITH "TIME_IN", field_type WITH "N", field_len WITH 5, field_dec WITH 0
APPEND BLANK
REPLACE field_name WITH "DATE_OUT", field_type WITH "D", field_len WITH 8, field_dec WITH 0
APPEND BLANK
REPLACE field_name WITH "WEEK_OUT", field_type WITH "N", field_len WITH 2, field_dec WITH 0
APPEND BLANK
REPLACE field_name WITH "TIME_OUT", field_type WITH "N", field_len WITH 5, field_dec WITH 0
APPEND BLANK
REPLACE field_name WITH "ELAPSED", field_type WITH "N", field_len WITH 10, field_dec WITH 2
APPEND BLANK
REPLACE field_name WITH "TIME_OF_CL", field_type WITH "C", field_len WITH 8, field_dec WITH 0
APPEND BLANK
REPLACE field_name WITH "SUPPORT_NO", field_type WITH "N", field_len WITH 6, field_dec WITH 0
APPEND BLANK
REPLACE field_name WITH "SERIAL_NO", field_type WITH "C", field_len WITH 8, field_dec WITH 0
APPEND BLANK
REPLACE field_name WITH "COMPUTER", field_type WITH "C", field_len WITH 20, field_dec WITH 0
APPEND BLANK
REPLACE field_name WITH "OP_SYSTEM", field_type WITH "C", field_len WITH 5, field_dec WITH 0
APPEND BLANK
REPLACE field_name WITH "NAME", field_type WITH "C", field_len WITH 30, field_dec WITH 0
APPEND BLANK
REPLACE field_name WITH "COMPANY", field_type WITH "C", field_len WITH 30, field_dec WITH 0
APPEND BLANK
REPLACE field_name WITH "ADDRESS_1", field_type WITH "C", field_len WITH 25, field_dec WITH 0
APPEND BLANK
REPLACE field_name WITH "ADDRESS_2", field_type WITH "C", field_len WITH 25, field_dec WITH 0
APPEND BLANK
REPLACE field_name WITH "CITY", field_type WITH "C", field_len WITH 20, field_dec WITH 0
APPEND BLANK
REPLACE field_name WITH "STATE", field_type WITH "C", field_len WITH 2, field_dec WITH 0
APPEND BLANK
REPLACE field_name WITH "ZIP", field_type WITH "C", field_len WITH 5, field_dec WITH 0
APPEND BLANK
REPLACE field_name WITH "PHONE_ONE", field_type WITH "C", field_len WITH 21, field_dec WITH 0
APPEND BLANK
REPLACE field_name WITH "PHONE_TWO", field_type WITH "C", field_len WITH 21, field_dec WITH 0
APPEND BLANK
REPLACE field_name WITH "PROBLEM_1", field_type WITH "C", field_len WITH 60, field_dec WITH 0
APPEND BLANK
REPLACE field_name WITH "PROBLEM_2", field_type WITH "C", field_len WITH 60, field_dec WITH 0
APPEND BLANK
REPLACE field_name WITH "PROBLEM_3", field_type WITH "C", field_len WITH 60, field_dec WITH 0
APPEND BLANK
REPLACE field_name WITH "PERSONAL", field_type WITH "C", field_len WITH 15, field_dec WITH 0
USE
CREATE &scrdata.LOG_CALL FROM Template
USE &scrdata.LOG_CALL
ERASE Template
@ 10, 5 SAY SPACE(70)
@ 11, 5 SAY "Creating Control Number Index"
temp = scrdata + "LOG_CA_1.DAT"
INDEX ON control_no TO &temp
@ 11, 2 SAY SPACE(70)


********************

PROCEDURE Cainthd


RESTORE FROM Screen.sys ADDITIVE
DO Setup
CLEAR
DO Redraw WITH "Initializing Databases"
@ 5,0,23,79 BOX SUBSTR(scrframe,1,8)


********************

PROCEDURE Help


PARAMETERS p,l,v

SAVE SCREEN
SET SCOREBOARD OFF
frame = CHR(201) + CHR(205) + CHR(187) + CHR(186) + ;
CHR(188) + CHR(205) + CHR(200) + CHR(186) + CHR(32)
p = p + SPACE(10 - LEN(p))
v = v + SPACE(10 - LEN(v))
IF .NOT. FILE("HELP.DBF")
@ 00,10,03,70 BOX scrframe
@ 01,11 SAY "There is no HELP file available. Would you like a help "
@ 02,27 SAY "file to be generated?"
IF .NOT. VERIFY()
RESTORE SCREEN
SET KEY 28 TO Help
RETURN
ENDIF
goback = SELECT()
DO Dohelp
tempgo = STR(goback)
SELECT &tempgo
ENDIF
goback = SELECT()
SELECT 9
USE Help INDEX Help
SET FILTER TO search_p = p .AND. search_v = v
LOCATE FOR search_l = l
IF FOUND()
@ top,left,bottom,right BOX frame
IF "" = MEMOEDIT(helpscr,top+1,left+1,bottom-1,right-1,.F.)
ENDIF
@ bottom-1,left+1 SAY "Any Key to Continue..."
ELSE
@ 00,10,03,70 BOX scrframe
@ 01,11 SAY "There is no HELP for this section. Would you like to make"
@ 02,28 SAY "a HELP screen for this? "
IF .NOT. VERIFY()
RESTORE SCREEN
SET KEY 28 TO Help
RETURN
ENDIF
APPEND BLANK
REPLACE search_p WITH p, search_l WITH l, search_v WITH v
STORE SPACE(4000) TO in_help
STORE 0 TO temp_top, temp_left, temp_bot, temp_right
DO WHILE .T.
@ 00,10,03,70 BOX scrframe
@ 01,20 SAY "Position cursor with arrow for TOP, LEFT corner."
cursor = 0
@ 12,40 SAY ""
DO WHILE.T.
cursor = INKEY(0)
DO CASE
CASE cursor = 5
@ ROW() - 1, COL() SAY ""
CASE cursor = 4
@ ROW(), COL() + 1 SAY ""
CASE cursor = 19
@ ROW(),COL() - 1 SAY ""
CASE cursor = 24
@ ROW() + 1,COL() SAY ""
CASE cursor = 13 .OR. cursor = 27
EXIT
ENDCASE
ENDDO
STORE ROW() TO temp_top
STORE COL() - 1 TO temp_left
@ 00,10,03,70 BOX scrframe
@ 01,20 SAY "Position cursor with arrow for BOTTOM, RIGHT corner."
cursor = 0
@ 12,40 SAY ""
DO WHILE.T.
cursor = INKEY(0)
DO CASE
CASE cursor = 5
@ ROW() - 1, COL() SAY ""
CASE cursor = 4
@ ROW(), COL() + 1 SAY ""
CASE cursor = 19
@ ROW(),COL() - 1 SAY ""
CASE cursor = 24
@ ROW() + 1,COL() SAY ""
CASE cursor = 13 .OR. cursor = 27
EXIT
ENDCASE
ENDDO
STORE ROW() TO temp_bot
STORE COL() TO temp_right
CALL _scrsave WITH in_help
DO Temphelp
@ 00,10,03,70 BOX scrframe
@ 02,25 SAY "Is this what you wanted? "
IF .NOT. VERIFY()
CALL _scrrest WITH in_help
LOOP
ENDIF
REPLACE top WITH temp_top, bottom WITH temp_bot, left WITH temp_left, right WITH temp_right
EXIT
ENDDO
DO WHILE .T.
@ top,left,bottom,right BOX frame
REPLACE helpscr WITH MEMOEDIT(helpscr,top+1,left+1,bottom-1,right-1,.T.)
@ top,left,bottom,right BOX frame
IF "" = MEMOEDIT(helpscr,top+1,left+1,bottom-1,right-1,.F.)
ENDIF
@ bottom-1,left+1 SAY "IS THIS CORRECT? "
IF .NOT. VERIFY()
LOOP
ENDIF
EXIT
ENDDO
@ bottom-1,left+1 SAY "Press Any key to Continue...."
ENDIF
qw = INKEY(0)
RESTORE SCREEN
SET KEY 28 TO Help
tempgo = STR(goback)
SELECT &tempgo
RETURN

********************

PROCEDURE Dohelp

SELECT 9
CREATE Temp
USE Temp
APPEND BLANK
REPLACE field_name WITH "SEARCH_P", field_type WITH "C", field_len WITH 10
APPEND BLANK
REPLACE field_name WITH "SEARCH_V", field_type WITH "C", field_len WITH 10
APPEND BLANK
REPLACE field_name WITH "SEARCH_L", field_type WITH "N", field_len WITH 4
APPEND BLANK
REPLACE field_name WITH "TOP", field_type WITH "N", field_len WITH 2
APPEND BLANK
REPLACE field_name WITH "LEFT", field_type WITH "N", field_len WITH 2
APPEND BLANK
REPLACE field_name WITH "BOTTOM", field_type WITH "N", field_len WITH 2
APPEND BLANK
REPLACE field_name WITH "RIGHT", field_type WITH "N", field_len WITH 2
APPEND BLANK
REPLACE field_name WITH "HELPSCR", field_type WITH "M", field_len WITH 10
USE
CREATE Help FROM Temp
ERASE Temp
USE Help
INDEX ON search_p + search_v TO Help

********************

PROCEDURE Temphelp

IF scrcolor
SET COLOR TO W*+
ELSE
SET COLOR TO W+
ENDIF
@ temp_top, temp_left, temp_bot, temp_right BOX SUBSTR(scrframe,1,8)
IF scrcolor
SET COLOR TO 7+
ELSE
SET COLOR TO 7
ENDIF

********************

PROCEDURE Reinitx


@ 19,25,23,65 BOX scrframe
tempscr = SPACE(4000)
CALL _scrsave WITH tempscr
@ 20,29 SAY " Data Files are present. If you"
@ 21,29 SAY "continue, all data will be lost."
@ 22,29 SAY "Do you want to continue? "
IF .NOT. VERIFY()
RETURN
ENDIF
CALL _scrrest WITH tempscr
@ 20,29 SAY "Would you like to re-Create"
@ 21,29 SAY "ALL of the databases?"
IF VERIFY()
DO Cainit
RETURN
ENDIF
CALL _scrrest WITH tempscr
@ 20,28 SAY "Do you wish to re-create the"
@ 21,40-LEN("CONTRACT")/2 SAY "CONTRACT"
@ 22,28 SAY "Database? (Yes / No)"
IF VERIFY()
DO Cainthd
DO Cainit1
ENDIF
CALL _scrrest WITH tempscr
@ 20,28 SAY "Do you wish to re-create the"
@ 21,40-LEN("LOG_CALL")/2 SAY "LOG_CALL"
@ 22,28 SAY "Database? (Yes / No)"
IF VERIFY()
DO Cainthd
DO Cainit2
ENDIF
CLOSE DATABASES

********************

PROCEDURE Default

@ 19,25,23,65 BOX scrframe
whichone = 1
@ 20,32 PROMPT " 1> Change Directory "
@ 21,32 PROMPT " 2> Change System Defaults "
@ 22,32 SAY " ESC to RETURN TO MENU"
MENU TO whichone
DO CASE
CASE whichone = 0
RETURN
CASE whichone = 2
DO Scrinit
OTHERWISE
@ 20,26,22,64 BOX SPACE(9)
indir = SPACE(30)
@ 20,28 SAY "Enter in new PATH..."
@ 21,28 SAY "->" GET indir PICT "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
READ
DO WHILE .NOT. FILE(scrprog + "\COMMAND.COM")
@ 20,26,22,64 BOX SPACE(9)
@ 20,28 SAY "Please insert DOS disk in drive :" + SUBSTR(scrprog,1,1)
@ 21,28 SAY "Any key or Q to Quit ......."
IF QWAIT()
RETURN
ENDIF
ENDDO
indir = "CD " + TRIM(indir)
RUN &indir
DO Beginit
RETURN
ENDCASE

********************

PROCEDURE Password

@ 19,25,23,65 BOX scrframe
temp = SPACE(15)
@ 20,28 SAY "Leave Blank to keep old Password"
@ 21,28 SAY "Enter New Password: " GET temp PICT "XXXXXXXXXXXXXXX"
READ
IF LEN(TRIM(tem)) <> 0
scrpass = GENPASS(temp)
ENDIF
@ 20,26,22,64 BOX SPACE(9)
@ 21,27 SAY "Enter Times for Password: " GET scrtimes PICT "##"
READ
SET DEFAULT TO &scrprog
SAVE ALL LIKE scr* TO Screen.sys
SET DEFAULT TO &scrdata

********************

PROCEDURE Olddate

@ 19,25,23,75 BOX scrframe
@ 20,29 SAY "Changing System Date"
STORE "Today's Date is " + CDOW(DATE()) + ", " + CMON(DATE()) to prompt
STORE prompt + " " + STR(DAY(DATE()),2) + ", " + STR(YEAR(DATE()),4) to
prompt
@ 21,69 SAY prompt
mdate = DATE()
@ 22,29 SAY "Enter in Date: " GET mdate
READ
IF FILE(scrprog + "\COMMAND.COM")
mdate = DTOC(mdate)
RUN DATE &mdate
ENDIF

********************

PROCEDURE Unmark

@ 19,25,23,65 BOX scrframe
tempscr = SPACE(4000)
CALL _scrsave WITH tempscr
updated = .F.
CALL _scrrest WITH tempscr
@ 20,27 SAY "Do you wish to UNMARK data in the "
@ 21,27 SAY "CONTRACT file? "
IF VERIFY()
SELECT 1
USE &scrdata.CONTRACT
RECALL ALL
updated = .T.
ENDIF
CALL _scrrest WITH tempscr
@ 20,27 SAY "Do you wish to UNMARK data in the "
@ 21,27 SAY "LOG_CALL file? "
IF VERIFY()
SELECT 1
USE &scrdata.LOG_CALL
RECALL ALL
updated = .T.
ENDIF
CALL _scrrest WITH tempscr
IF updated
@ 21,27 SAY "Process Complete. Any Key to Resort"
IF INKEY(0) = 0
ENDIF
DO Resort
ELSE
@ 21,27 SAY "Process Complete. Any Key to Continue"
IF INKEY(0) = 0
ENDIF
ENDIF

********************

PROCEDURE Removeit

@ 19,25,23,65 BOX scrframe
tempscr = SPACE(4000)
CALL _scrsave WITH tempscr
updated = .F.
CALL _scrrest WITH tempscr
@ 20,27 SAY "Do you wish to REMOVE data in the "
@ 21,27 SAY "CONTRACT file? "
IF VERIFY()
SELECT 1
USE &scrdata.CONTRACT
PACK
updated = .T.
ENDIF
CALL _scrrest WITH tempscr
@ 20,27 SAY "Do you wish to REMOVE data in the "
@ 21,27 SAY "LOG_CALL file? "
IF VERIFY()
SELECT 1
USE &scrdata.LOG_CALL
PACK
updated = .T.
ENDIF
CALL _scrrest WITH tempscr
IF updated
@ 21,27 SAY "Process Complete. Any Key to Resort"
IF INKEY(0) = 0
ENDIF
DO Resort
ELSE
@ 21,27 SAY "Process Complete. Any Key to Continue"
IF INKEY(0) = 0
ENDIF
ENDIF


********************

PROCEDURE Resort

@ 5,0,23,79 BOX scrframe
SELECT 1
USE &scrdata.CONTRACT
@ 6, 5 SAY "Creating Support Number Index"
temp = scrdata + "CONTRA_1.DAT"
INDEX ON support_no TO &temp
@ 6, 2 SAY SPACE(70)
@ 7, 5 SAY "Creating Phone Number Index"
temp = scrdata + "CONTRA_2.DAT"
INDEX ON phone_no TO &temp
@ 7, 2 SAY SPACE(70)
@ 8, 5 SAY "Creating Company Name Index"
temp = scrdata + "CONTRA_3.DAT"
INDEX ON company TO &temp
@ 8, 2 SAY SPACE(70)
USE &scrdata.LOG_CALL
@ 9, 5 SAY SPACE(70)
@ 10, 5 SAY "Creating Control Number Index"
temp = scrdata + "LOG_CA_1.DAT"
INDEX ON control_no TO &temp

* End of CALL.prg