coding tutorial
- Thread starter shoshi
- Start date
miketx
Diamond Member
- Dec 25, 2015
- 121,555
- 70,600
- 2,645
- Banned
- #3
$IF 0
ﾚﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄｿ
ï½³ N O T I C E ï½³
ï½³ IT IS CONSIDERED A TRADE SECRET AND IS NOT TO BE DIVULGED ï½³
ï½³ OR USED BY PARTIES WHO HAVE NOT RECEIVED WRITTEN AUTHORIZATION FROM ï½³
ï½³ THE OWNER. VIOLATERS WILL BE SEVERELY PUNISHED TO THE FULL EXTENT ï½³
ï½³ OF THE LAW. ALL LEGAL REMEDYS AND AVENUES WILL BE PURSUED RELENTLESSLY.ï½³
ï½³ NON-DISCLOSURE AGREEMENTS ARE AVAILABLE TO NECCESARY INDIVIDUALS. ï½³
ï½³ THANK YOU. ï½³
ﾀﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾙ
$ENDIF
'module acct - accounting services
$COMPILE CHAIN
$STRING 4
$OPTION CNTLBREAK OFF
$ERROR ALL OFF
$STACK 5120
$OPTIMIZE SIZE
$CPU 80386
$DYNAMIC
$INCLUDE "\pb32\pbwindo.inc"
TIMER OFF
DEFINT a-z
OPtion base 1
COMMON recordnumber%, director%, var1%, var2%, var3%, var4%, var5%, partarray$( 1 ), _
top_line%,pick_line%,Gco.name$,Gceo$,Gaddress$,Gcity$,Gcounty$,Gstate$,Gzip$,Gphone1$,Gphone2$, _
Gdpercent$,Gfed$,Gtaxrate$,Gpassword$,Gpc$,Gepafee$,Glabortax$, _
Gpercenttot$,Gmaxepa$,Glabortaxrate$,Gscreensaverdelay$,Gscreensavetype$, _
Gallow_dos_access$,Gtempvar1$,Gtempvar2$,Gtempvar3$,Gid$(1),Gpass$(1),Gaccess$(1),Grecords%
clearkbd
'var1% = 1
%true = -1
%false = 0
password_is_checked% = %false
callflag% = %false
EXIT FAR AT startprog
startprog:
IF var1% THEN
callflag% = %true
cut_records
END IF
SELECT CASE Grecords%
CASE > 0
IF password_is_checked% = %false THEN passwrd 1
CASE 0
EXIT SELECT
END SELECT
start
END
SUB start
SHARED client_name$,labor_chrg$,part_chrg$,tax_chrg$,record_date$
SHARED payment_type$,new_bal$,epa_chrg$,taxable$,client_record_number$
SHARED ar_payment_amount$,ar_payment_date$,ar_main_record_num$,acctrec%
SHARED ptr%,maxitem%,save%,julian&,eptr%,emaxitem%,counter%
SHARED recordnumber%, director%, var1%, var2%, var3%, var4%, var5%, partarray$()
SHARED larr$(),record_nums%()
LOCAL j%
COLOR 7,1
CLS
save% = 0 'control exit from loop to start search
text1$ = DATE$
text2$ = DATE$
s$ = savescreen$
popwindow 10,20,14,60,4,fnattr%(7,1),0,-5,0,""
COLOR 0,7
LOCATE 12,26
RINT text1$
LOCATE 12,45RINT text2$
FIRST$ = SAVESCREEN$
xqprint SPACE$(22)+"ENTER DATES - F2=START ESC=EXIT F4=A/R"+SPACE$(22),25,1,fnattr%(9,0)
maxitem% = 2
ptr% = 1
'****************** get date range to look at records from *********************
DO
SELECT CASE ptr%
CASE 1
row% = 12:col% = 26
lineEdit text1$, row%, col%, lineLen%, editkey%, 0, 7
CASE 2
row% = 12:col% = 45
lineEdit text2$, row%, col%, lineLen%, editkey%, 0, 7
END SELECT
IF save% = 1 THEN EXIT DO
LOOP
LOCATE 1,1,0
ctext 14,"<< CREATING REPORT >>",23,1
open_data_base
IF acctrec% < 500 THEN
DELAY 1.5
END IF
julian& = 0
firstdate& = 0
secondDate& = 0
d$ = ""
d$ = text1$
d$ = RTRIM$(d$)
month% = VAL(LEFT$(d$,2))
day% = VAL(mid$(D$,4,2))
year% = VAL(RIGHT$(d$,4))
mdy month%,day%,year%
firstdate& = julian&
julian& = 0
d$ = ""
d$ = text2$
d$ = RTRIM$(d$)
month% = VAL(LEFT$(d$,2))
day% = VAL(mid$(D$,4,2))
year% = VAL(RIGHT$(d$,4))
mdy month%,day%,year%
secondDate& = julian&
timespan% = secondDate&-firstdate&
IF timespan% > 365 THEN errormsg
counter% = 0
'***** read records and save record numbers that are a date match ******************
OPEN "store.dta" FOR OUTPUT AS #2
FOR j% = 1 TO acctrec%
GET #14,j%
IF VAL(record_date$) >= firstdate& THEN
IF VAL(record_date$) <=secondDate& THEN
INCR counter%
WRITE #2,j%
END IF
END IF
NEXT
CLOSE #2,#14
IF counter% = 0 THEN
error_msg_date " SORRY, NO RECORDS FOUND FOR DATE(S) ENTERED!"
EXIT FAR
END IF
display_records text1$,text2$,firstdate&,secondDate&
END SUB
SUB error_msg_date (message$)
LOCAL a$
CLOSE
SOUND 150,.5
SOUND 234,.6
SOUND 150,.8
SOUND 234,1
popwindow 10,15,15,65,1,fnattr%(14,4),0,-5,0,""
ctext 12, message$,14,4
ctext 14 ,"PRESS ANY KEY...",14,4
a$ = INPUT$(1)
EXIT SUB
END SUB
SUB display_records(text1$,text2$,firstdate&,secondDate&)
SHARED client_name$,labor_chrg$,part_chrg$,tax_chrg$,record_date$,Grecords%
SHARED payment_type$,new_bal$,epa_chrg$,taxable$,client_record_number$
SHARED ar_payment_amount$,ar_payment_date$,ar_main_record_num$,acctrec%
SHARED ptr%,maxitem%,save%,julian&,true_date$,eptr%,emaxitem%,direction%
SHARED zclient_name$,zlabor_chrg$,zpart_chrg$,ztax_chrg$,zrecord_date$
SHARED zpayment_type$,zepa_chrg$,file_location%,ar_ptr%,exitflag%,zdiscount$
SHARED zname$,zamount$,zdate$,zptr%,zmaxitem%,return_flag%,zroapaid$,originalpay$
SHARED pick_line%,top_line%,record_nums%(),counter%,larr$()
LOCAL fileptr%,recnum%,labor!,parts!,tax!,epa!,total!,item$(),record%
LOCAL erow%,ecol%,count%,ar_payments_total!,ar_total!,j%,ar_count%,loopcount%
LOCAL max_name_len%,target_name%,diffrence%
max_name_len% = 0
target_name% = 0
diffrence% = 0
showdata:
file_location% = 0
ERASE record_nums%
DIM record_nums%(counter%)
OPEN "store.dta" FOR INPUT AS #2
fileptr% = 1
true_date$ = ""
'*********** read record numbers into an array *********************
DO UNTIL EOF(2)
INPUT #2,recnum%
record_nums%(fileptr%) = recnum%
INCR fileptr%
LOOP
CLOSE #2
roa_flag% = 0
totreceive! = 0
labor!=0
parts!=0
tax!=0
epa!=0
total!=0
total_ar!=0
ar_recv!=0
tot_discount! = 0
open_data_base
ERASE larr$
DIM larr$(counter%+1)
FOR j% = 1 TO counter%
GET #14,record_nums%(j%)
discount! = CVS(client_record_number$)
target_date& = 0
target_date& = VAL(record_date$)
julian.to.mdy target_date&,0,0,0,0
SELECT CASE payment_type$
CASE "1"
howpayed$ = "CASH"
CASE "2"
howpayed$ = "CHRG"
INCR total_ar!,(CVS(labor_chrg$)+CVS(part_chrg$)+CVS(tax_chrg$)+CVS(epa_chrg$))
CASE "3"
howpayed$ = "CHEC"
CASE "4"
howpayed$ = "M/CD"
CASE "5"
howpayed$ = "VISA"
CASE "6"
howpayed$ = "DISC"
CASE "7"
howpayed$ = "AMEX"
CASE "8"
howpayed$ = "R/OA"
INCR roa_flag%
END SELECT
d$ = true_date$
month$ = LEFT$(d$,2)
day$ = mid$(D$,4,2)
year$ = RIGHT$(d$,4)
year$ = RIGHT$(year$,2)
d$ = month$+"-"+day$+"-"+year$
p_cliname$ = client_name$
clname$ =LEFT$(client_name$,14)
' IF RTRIM$(howpayed$) = "R/OA" THEN GOTO no_tot
linetot! = (CVS(epa_chrg$)+CVS(tax_chrg$)+CVS(labor_chrg$)+CVS(part_chrg$)) - discount!
' no_tot:
larr$(j%) = d$+" "+clname$+" "+ USING$("####.##",CVS(ar_payment_amount$))+" "+USING$("#####.##",(CVS(labor_chrg$)+CVS(part_chrg$))) _
+" "+USING$("####.##",CVS(tax_chrg$))+" "+USING$("####.##",CVS(epa_chrg$))+" "+USING$("######.##",linetot!) _
+" "+howpayed$
INCR labor!,CVS(labor_chrg$)
INCR parts!,CVS(part_chrg$)
INCR tax!,CVS(tax_chrg$)
INCR epa!,CVS(epa_chrg$)
INCR ar_recv!,CVS(ar_payment_amount$)
INCR tot_discount!,discount!
NEXT
labor! = ROUND(labor!,2)
parts! = ROUND(parts!,2)
tax! = ROUND(tax!,2)
epa! = ROUND(epa!,2)
ar_recv! = ROUND(ar_recv!,2)
tot_discount! = ROUND(tot_discount!,2)
'total! = (labor!+parts!+tax!+epa!+ar_recv!)
total! = (labor!+parts!+tax!+epa!)-tot_discount!
totreceive! = (total!+ar_recv!) -total_ar!
totreceive! = ROUND(totreceive!,2)
'total! = total!+ar_recv!+total_ar!
'total! = total!+total_ar!
CLOSE #14
COLOR 7,1
CLS
xqprint SPACE$(80) ,1,1,fnattr%(7,4)
ctext 1,"SALES REPORT FOR THE PERIOD "+text1$+" TO "+text2$,7,4
xqprint STRING$(80,196),2,1,fnattr%(7,1)
xqprint "DATE NAME A/R PARTS&LABOR TAX EPA TOTAL PAID",3,1,fnattr%(7,1)
xqprint STRING$(80,196),4,1,fnattr%(7,1)
popwindow 19,2,23,79,1,fnattr%(15,1),0,0,0,""
xqprint STRING$(78,196),20,2,fnattr%(15,1)
xqprint " LABOR PARTS TAX EPA CHRG RCVD ON ACCT",19,2,fnattr%(15,1)
Xqprint USING$("######.##",labor!)+" "+USING$("######.##",parts!) _
+" "+USING$("####.##",tax!)+" "+USING$("####.##",epa!) _
+" "+USING$("######.##",total_ar!)+" "+USING$("######.##",ar_recv!),21,2,fnattr%(15,1)
xqprint STRING$(78,196),22,2,fnattr%(15,1)
'ctext 23,"Total Sales = "+LTRIM$(USING$("######.##",total!))+" Total Rcvd = "+LTRIM$(USING$("######.##",totreceive!))+" (TOTAL + R/OA) - CHRG",15,1
total! = ROUND(total!,2):tot_discount! = ROUND(tot_discount!,2)
ctext 23,"SALES = "+LTRIM$(USING$("######.##",total!))+" COLLECTED = "+LTRIM$(USING$("######.##",totreceive!))+" DISCOUNTS = "+USING$("#####.##",tot_discount!),15,1
aro# = total! / (counter%-roa_flag%)
num_of_ta$ = STR$(counter%-roa_flag%)
num_of_ta$=LTRIM$(num_of_ta$)
average$ = USING$("#####.##",aro#)
average$ = LTRIM$(average$)
xqprint "[ "+num_of_ta$+" ENTRIES AVERAGING "+average$+" ]",2,45,fnattr%(7,1)
labor!=0
parts!=0
tax!=0
epa!=0
total!=0
page% = 1
'xqprint "PAGE "+STR$(page%),1,2,fnattr%(7,1)
xqprint " ALT+F1=CALCULATOR ESC=NEW ENTER=EDIT F2=ADD F4=A/R F5=DELETE F6=PRINT ",25,2,fnattr%(7,1)
Yy%=0
editflag% = 0
DO
INCR Yy%
IF LEN(LARR$(Yy%)) > MaxLen% THEN MaxLen%=LEN(LARR$(Yy%))
IF LEN(LARR$(Yy%)) = 0 THEN ListLen%=Yy%: EXIT LOOP
LOOP
COLOR 7,1
strenleng% = LEN(larr$(yy%))
WinTop%=4:WinLeft%=1
WinBot% = (WinTop% +1+ Yy%)-1:If WinBot% > 18 THEN WinBot% = 18
TopLine% = 0 ' the first element to appear inside the box
PickLine% = 1 ' the offset box line you are pointing at
DO ' Main loop start
For Yy% = WinTop%+1 TO winbot%-1
IF Yy% = WinTop% + PickLine% THEN
IF INSTR(larr$(Yy%-WinTop%+TopLine%),"CHRG") THEN
f% = 4:b%=7
ELSE
f%=1:b%=7
END IF
ELSE
IF INSTR(larr$(Yy%-WinTop%+TopLine%),"CHRG") THEN
f%=12:b% = 1
ELSE
f% = 7:b% = 1
END IF
END IF
xqprint LEFT$(LARR$(Yy%-WinTop%+TopLine%),80) ,yy%,1,fnattr%(f%,b%)
Next Yy%
DO:A$=INKEY$
LOCATE 1,1
LOOP WHILE A$=""
SELECT CASE A$
CASE CHR$(0,104) 'ALT F1
EXIT FAR AT ret_from_scalc
s_calc$ = savescreen$
scalc
ret_from_scalc:
LOCATE 1,1,0
restorescreen s_calc$
GOTO endloop
CASE CHR$(0,61)
CLOSE
REDIM larr$(counter%+1)
ERASE larr$,record_nums%
MEMPACK
RUN "start.exe"
CASE CHR$(0,&H49) 'page up
IF PickLine%=1 then _
TopLine%=TopLine%-(WinBot%-winTop%)+2 else _
PickLine%=1
CASE CHR$(0,&H51) 'page dn
IF PickLine%=WinBot%-WinTop%-1 THEN _
TopLine%=TopLine%+(WinBot%-WinTop%)-2 else _
PickLine%=WinBot%-WinTop%-1
CASE CHR$(0,&H48) 'up arrow
DECR PickLine%
CASE CHR$(0,&H50) 'dn arrow
INCR PickLine%
CASE CHR$(0,63)
CLOSE
open_data_base
GET #14, record_nums%(topline%+pickline%)
name_of_owner$ = RTRIM$(client_Name$)
IF payment_type$ = "2" THEN
FOR check_ar_flag% = 1 TO acctrec%
GET #14,check_ar_flag%
IF VAL(ar_main_record_num$) = record_nums%(topline%+pickline%) THEN
del$ = savescreen$
popwindow 8,18,11,62,1,fnattr%(0,3),0,0,0,""
ctext 8,"RECORD OWNER -> "+name_of_owner$,0,3
error_msg_date "CANNOT DELETE! RECORD HAS PAYMENT HISTORY!"
restorescreen del$
CLOSE
GOTO endloop
END IF
NEXT
END IF
doYouWantToDoThis 1
IF return_flag% = 1 THEN
restorescreen del$
CLOSE
GOTO endloop
END IF
rec_num% = (record_nums%(topline%+pickline%))
ERASE larr$,record_nums%
delete_record rec_num%
CASE CHR$(0,64)
print_report larr$(),record_nums%(),firstdate&,secondDate&
GOTO endloop
CASE CHR$(27)
CLOSE
OPEN "store.dta" FOR OUTPUT AS #2 ' delete the sequential file
ERASE record_nums%
CLOSE #2
EXIT FAR
CASE CHR$(13)
SELECT CASE Grecords%
CASE > 0
passwrd 1
CASE 0
EXIT SELECT
END SELECT
shared change%
s$ = savescreen$
open_data_base
file_location% = record_nums%(topline%+pickline%)
discount_! = 0
GET #14,file_location%
discount_! = CVS(client_record_number$)
ehowpayed$ = ""
zpayment_type$ = ""
originalpay$ = ""
originalpay$ = payment_type$
SELECT CASE payment_type$
CASE "1"
ehowpayed$ = "CASH"
CASE "2"
ehowpayed$ = "CHRG"
CASE "3"
ehowpayed$ = "CHEC"
CASE "4"
ehowpayed$ = "M/CD"
CASE "5"
ehowpayed$ = "VISA"
CASE "6"
ehowpayed$ = "DISC"
CASE "7"
ehowpayed$ = "AMEX"
CASE "8"
ehowpayed$ = "R/OA"
END SELECT
SELECT CASE ehowpayed$
CASE "BIGBUNCHOFBULLSHIT"
del$ = savescreen$
popwindow 8,18,11,62,1,fnattr%(0,3),0,0,0,""
owner$ = RTRIM$(client_Name$)
IF RTRIM$(owner$) = "" THEN owner$ = "A/R Module"
ctext 8,"RECORD OWNER -> "+owner$,0,3
error_msg_date "ERROR! - CAN'T EDIT R/OA ENTRYS HERE!
restorescreen del$
CLOSE #14
GOTO endloop
CASE ELSE
top_msg$ = "EDIT SALES ENTRY"
END SELECT
xqprint SPACE$(79),25,1,fnattr%(7,1)
popwindow 6,15,18,65,2,fnattr%(14,1),0,0,0,""
ctext 7,STRING$(51,196),7,1
ctext 6,top_msg$,7,1
GET #14,file_location%
eptr% = 1
emaxitem% = 8
zlabor_chrg! = 0
zpart_chrg! = 0
ztax_chrg! = 0
zepa_chrg! = 0
zclient_name$ = client_name$
zlabor_chrg! = CVS(labor_chrg$)
zpart_chrg! = CVS(part_chrg$)
ztax_chrg! = CVS(tax_chrg$)
zepa_chrg! = CVS(epa_chrg$)
zlabor_chrg$ = USING$("#####.##",CVS(labor_chrg$))
zpart_chrg$ = USING$("#####.##",CVS(part_chrg$))
ztax_chrg$ = USING$("#####.##",CVS(tax_chrg$))
zepa_chrg$ = USING$("#####.##",CVS(epa_chrg$))
zlabor_chrg$ = LTRIM$(zlabor_chrg$)+SPACE$(4)
zpart_chrg$ = LTRIM$(zpart_chrg$)+SPACE$(4)
ztax_chrg$ = LTRIM$(ztax_chrg$)+SPACE$(4)
zepa_chrg$ = LTRIM$(zepa_chrg$)+SPACE$(4)
zroapaid$ = USING$("#####.##",CVS(ar_payment_amount$))
zroapaid$ = LTRIM$(zroapaid$)+SPACE$(4)
'************ convert julian date to calendar date ***************
target_date& = 0
target_date& = VAL(record_date$)
julian.to.mdy target_date&,0,0,0,0
zrecord_date$ = true_date$
IF discount_! > 0 THEN
xqprint "DISCOUNT : "+USING$("-###.##",discount_!),8,15,fnattr%(12,1)
END IF
xqprint "CLIENT : "+zclient_name$,9,15,fnattr%(7,1)
xqprint "DATE : "+zrecord_date$,10,15,fnattr%(7,1)
xqprint "PAID : "+ehowpayed$,11,15,fnattr%(7,1)
xqprint "LABOR : "+zlabor_chrg$,12,15,fnattr%(7,1)
xqprint "PARTS : "+zpart_chrg$,13,15,fnattr%(7,1)
xqprint "TAX : "+ztax_chrg$,14,15,fnattr%(7,1)
xqprint "EPA : "+zepa_chrg$,15,15,fnattr%(7,1)
xqprint "R/OA : "+zroapaid$,16,15,fnattr%(7,1)
ctext 17,STRING$(51,196),7,1
ctext 18,"F2=SAVE CHANGES ESC=EXIT",7,1
ecol% = 26
change% = 0
DO
SELECT CASE eptr%
CASE 1
erow%= 9
editoneline zclient_name$,erow%,ecol%,lineLen%, editkey%, 7,0
CASE 2
erow%= 10
editoneline zrecord_date$,erow%,ecol%,lineLen%, editkey%, 7,0
CASE 3
erow%= 11
pop$ = savescreen$
DIM item$(9)
item$(1) = " CASH "
item$(2) = " CHRG "
item$(3) = " CHEC "
item$(4) = " M/CD "
item$(5) = " VISA "
item$(6) = " DISC "
item$(7) = " AMEX "
item$(8) = " R/OA "
item$(9) = " EXIT "
subscript% = 1
curntpos% = 1
itemcount% = UBOUND(item$(1))
row% = 8
col% = 50
downto% = row%+itemcount%
outTo% = LEN(item$(1))+col%-1
bordr% = 1
attr% = fnattr%(14,4)
mhattr% = fnattr%(0,7)
PopWindow row%,col%,downto%-1,outTo%,bordr%, attr%, 0, -5, 10, ""
for mloop% = 1 to itemcount%
xqprint item$(mloop%),mloop%+row%-1,col%,attr%
next
xqprint item$(1),row%,col%,mhattr%
DO
WHILE NOT INSTAT
WEND
ans$=inkey$
SELECT CASE ans$
CASE chr$(0,72)
xqprint item$(subscript%),curntpos%-1+row%,col%,attr%
DECR curntpos%
DECR subscript%
IF subscript% < 1 THEN
ERASE item$
LOCATE 1,1,0
restorescreen pop$
GOTO 101
END IF
IF curntpos% < 1 THEN
ERASE item$
LOCATE 1,1,0
restorescreen pop$
GOTO 101
END IF
CASE chr$(0,80)
xqprint item$(subscript%),curntpos%-1+row%,col%,attr%
INCR curntpos%
INCR subscript%
IF subscript% > UBOUND(item$(1)) THEN
ERASE item$
LOCATE 1,1,0
restorescreen pop$
GOTO 101
END IF
IF curntpos% > UBOUND(item$(1)) THEN
ERASE item$
LOCATE 1,1,0
restorescreen pop$
GOTO 101
END IF
CASE CHR$(27)
ERASE item$
LOCATE 1,1,0
restorescreen s$
GOTO endloop
CASE chr$(13)
SELECT CASE curntpos%
CASE 1
zpayment_type$ = "1"
change% = 1
GOTO 101
CASE 2
zpayment_type$ = "2"
change% = 1
GOTO 101
CASE 3
zpayment_type$ = "3"
change% = 1
GOTO 101
CASE 4
zpayment_type$ = "4"
change% = 1
GOTO 101
CASE 5
zpayment_type$ = "5"
change% = 1
GOTO 101
CASE 6
zpayment_type$ = "6"
change% = 1
GOTO 101
CASE 7
zpayment_type$ = "7"
change% = 1
GOTO 101
CASE 8
zpayment_type$ = "8"
change% = 1
GOTO 101
CASE 9
GOTO 101
END SELECT
END SELECT
xqprint item$(subscript%),curntpos%+row%-1,col%,mhattr%
LOOP
101:
ERASE item$
SELECT CASE direction% ' ********* determine if your going up or down ***********
CASE 1
eptr% = 2
CASE 2
eptr% = 4
END SELECT
restorescreen pop$
LOCATE erow%,ecol%:
COLOR 7,1
SELECT CASE zpayment_type$
CASE "1"
PRINT "CASH"
CASE "2"
PRINT "CHRG"
CASE "3"
PRINT "CHEC"
CASE "4"
PRINT "M/CD"
CASE "5"
PRINT "VISA"
CASE "6"
PRINT "DISC"
CASE "7"
PRINT "AMEX"
CASE "8"
PRINT "R/OA"
END SELECT
'editoneline zpayment_type$,erow%,ecol%,lineLen%, editkey%, 7,0
restorescreen pop$
CASE 4
erow%= 12
editoneline zlabor_chrg$,erow%,ecol%,lineLen%, editkey%, 7,0
CASE 5
erow%= 13
editoneline zpart_chrg$,erow%,ecol%,lineLen%, editkey%, 7,0
CASE 6
erow%= 14
editoneline ztax_chrg$,erow%,ecol%,lineLen%, editkey%, 7,0
CASE 7
erow%= 15
editoneline zepa_chrg$,erow%,ecol%,lineLen%, editkey%, 7,0
CASE 8
erow%= 16
editoneline zroapaid$,erow%,ecol%,lineLen%, editkey%, 7,0
END SELECT
'*************** exit edit procedure ******************
IF eptr% = 100 THEN
restorescreen s$
REDIM larr$(counter%+1)
REDIM record_nums%(counter%)
ERASE item$, record_nums%,larr$
CLOSE
LOCATE 1,1,0
EXIT FAR
END IF
IF eptr% = 50 THEN
restorescreen s$
CLOSE #14
LOCATE 1,1,0
GOTO endloop
END IF
LOOP
CASE CHR$(0,62)
CLOSE
REDIM larr$(counter%+1)
ERASE larr$,record_nums%
MEMPACK
CHAIN "ar.pbc"
CASE CHR$(0,60)
s$ = savescreen$
xqprint SPACE$(79),25,1,fnattr%(7,1)
popwindow 6,15,19,65,1,fnattr%(14,1),0,-5,0,""
xqprint STRING$(51,196),7,15,fnattr%(7,1)
ctext 6,"ENTER SALES TRANSACTION",7,1
eptr% = 1
emaxitem% = 8
zclient_name$ = SPACE$(25)
zlabor_chrg$ = SPACE$(12)
zpart_chrg$ = SPACE$(12)
ztax_chrg$ = SPACE$(10)
zepa_chrg$ = SPACE$(10)
zrecord_date$ = DATE$
zpayment_type$ = SPACE$(12)
zdiscount$ = SPACE$(20)
xqprint "CLIENT : "+zclient_name$,9,15,fnattr%(7,1)
xqprint "DATE : "+zrecord_date$,10,15,fnattr%(7,1)
xqprint "PAID : "+zpayment_type$,11,15,fnattr%(7,1)
xqprint "LABOR : "+zlabor_chrg$,12,15,fnattr%(7,1)
xqprint "PARTS : "+zpart_chrg$,13,15,fnattr%(7,1)
xqprint "TAX : "+ztax_chrg$,14,15,fnattr%(7,1)
xqprint "EPA : "+zepa_chrg$,15,15,fnattr%(7,1)
xqprint "DISCOUNT : "+zdiscount$,16,15,fnattr%(7,1)
xqprint STRING$(51,196),18,15,fnattr%(7,1)
ctext 19,"F2=SAVE RECORD ESC=EXIT",7,1
ecol% = 26
direction% = 0
DO
SELECT CASE eptr%
CASE 1
erow%= 9
editentry zclient_name$,erow%,ecol%,lineLen%, editkey%, 7,0
CASE 2
erow%= 10
editentry zrecord_date$,erow%,ecol%,lineLen%, editkey%, 7,0
CASE 3
erow%= 11
'***************** display spelling of payment types ***********
pop$ = savescreen$
DIM item$(9)
item$(1) = " CASH "
item$(2) = " CHRG "
item$(3) = " CHEC "
item$(4) = " M/CD "
item$(5) = " VISA "
item$(6) = " DISC "
item$(7) = " AMEX "
item$(8) = " R/OA "
item$(9) = " EXIT "
subscript% = 1
curntpos% = 1
itemcount% = UBOUND(item$(1))
row% = 8
col% = 50
downto% = row%+itemcount%
outTo% = LEN(item$(1))+col%-1
bordr% = 1
attr% = fnattr%(14,4)
mhattr% = fnattr%(0,7)
PopWindow row%,col%,downto%-1,outTo%,bordr%, attr%, 0, -5, 10, ""
for mloop% = 1 to itemcount%
xqprint item$(mloop%),mloop%+row%-1,col%,attr%
next
xqprint item$(1),row%,col%,mhattr%
DO
WHILE NOT INSTAT
WEND
ans$=inkey$
SELECT CASE ans$
CASE chr$(0,72)
xqprint item$(subscript%),curntpos%-1+row%,col%,attr%
DECR curntpos%
DECR subscript%
IF subscript% < 1 THEN subscript% = UBOUND(item$(1))
IF curntpos% < 1 THEN curntpos% = UBOUND(item$(1))
CASE chr$(0,80)
xqprint item$(subscript%),curntpos%-1+row%,col%,attr%
INCR curntpos%
INCR subscript%
IF subscript% > UBOUND(item$(1)) THEN subscript% = 1
IF curntpos% > UBOUND(item$(1)) THEN curntpos% = 1
CASE CHR$(27)
ERASE item$
restorescreen s$
GOTO endloop
CASE chr$(13)
SELECT CASE curntpos%
CASE 1
zpayment_type$ = "1"
GOTO 102
CASE 2
zpayment_type$ = "2"
GOTO 102
CASE 3
zpayment_type$ = "3"
GOTO 102
CASE 4
zpayment_type$ = "4"
GOTO 102
CASE 5
zpayment_type$ = "5"
GOTO 102
CASE 6
zpayment_type$ = "6"
GOTO 102
CASE 7
zpayment_type$ = "7"
GOTO 102
CASE 8
zpayment_type$ = "8"
GOTO 102
CASE 9
GOTO 102
END SELECT
END SELECT
xqprint item$(subscript%),curntpos%+row%-1,col%,mhattr%
ﾚﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄｿ
ï½³ N O T I C E ï½³
ï½³ THIS PROGRAM BELONGS TO AND IS THE SOLE PROPERTY OFï½³
ï½³ IT IS CONSIDERED A TRADE SECRET AND IS NOT TO BE DIVULGED ï½³
ï½³ OR USED BY PARTIES WHO HAVE NOT RECEIVED WRITTEN AUTHORIZATION FROM ï½³
ï½³ THE OWNER. VIOLATERS WILL BE SEVERELY PUNISHED TO THE FULL EXTENT ï½³
ï½³ OF THE LAW. ALL LEGAL REMEDYS AND AVENUES WILL BE PURSUED RELENTLESSLY.ï½³
ï½³ NON-DISCLOSURE AGREEMENTS ARE AVAILABLE TO NECCESARY INDIVIDUALS. ï½³
ï½³ THANK YOU. ï½³
ﾀﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾙ
$ENDIF
'module acct - accounting services
$COMPILE CHAIN
$STRING 4
$OPTION CNTLBREAK OFF
$ERROR ALL OFF
$STACK 5120
$OPTIMIZE SIZE
$CPU 80386
$DYNAMIC
$INCLUDE "\pb32\pbwindo.inc"
TIMER OFF
DEFINT a-z
OPtion base 1
COMMON recordnumber%, director%, var1%, var2%, var3%, var4%, var5%, partarray$( 1 ), _
top_line%,pick_line%,Gco.name$,Gceo$,Gaddress$,Gcity$,Gcounty$,Gstate$,Gzip$,Gphone1$,Gphone2$, _
Gdpercent$,Gfed$,Gtaxrate$,Gpassword$,Gpc$,Gepafee$,Glabortax$, _
Gpercenttot$,Gmaxepa$,Glabortaxrate$,Gscreensaverdelay$,Gscreensavetype$, _
Gallow_dos_access$,Gtempvar1$,Gtempvar2$,Gtempvar3$,Gid$(1),Gpass$(1),Gaccess$(1),Grecords%
clearkbd
'var1% = 1
%true = -1
%false = 0
password_is_checked% = %false
callflag% = %false
EXIT FAR AT startprog
startprog:
IF var1% THEN
callflag% = %true
cut_records
END IF
SELECT CASE Grecords%
CASE > 0
IF password_is_checked% = %false THEN passwrd 1
CASE 0
EXIT SELECT
END SELECT
start
END
SUB start
SHARED client_name$,labor_chrg$,part_chrg$,tax_chrg$,record_date$
SHARED payment_type$,new_bal$,epa_chrg$,taxable$,client_record_number$
SHARED ar_payment_amount$,ar_payment_date$,ar_main_record_num$,acctrec%
SHARED ptr%,maxitem%,save%,julian&,eptr%,emaxitem%,counter%
SHARED recordnumber%, director%, var1%, var2%, var3%, var4%, var5%, partarray$()
SHARED larr$(),record_nums%()
LOCAL j%
COLOR 7,1
CLS
save% = 0 'control exit from loop to start search
text1$ = DATE$
text2$ = DATE$
s$ = savescreen$
popwindow 10,20,14,60,4,fnattr%(7,1),0,-5,0,""
COLOR 0,7
LOCATE 12,26
RINT text1$LOCATE 12,45
RINT text2$FIRST$ = SAVESCREEN$
xqprint SPACE$(22)+"ENTER DATES - F2=START ESC=EXIT F4=A/R"+SPACE$(22),25,1,fnattr%(9,0)
maxitem% = 2
ptr% = 1
'****************** get date range to look at records from *********************
DO
SELECT CASE ptr%
CASE 1
row% = 12:col% = 26
lineEdit text1$, row%, col%, lineLen%, editkey%, 0, 7
CASE 2
row% = 12:col% = 45
lineEdit text2$, row%, col%, lineLen%, editkey%, 0, 7
END SELECT
IF save% = 1 THEN EXIT DO
LOOP
LOCATE 1,1,0
ctext 14,"<< CREATING REPORT >>",23,1
open_data_base
IF acctrec% < 500 THEN
DELAY 1.5
END IF
julian& = 0
firstdate& = 0
secondDate& = 0
d$ = ""
d$ = text1$
d$ = RTRIM$(d$)
month% = VAL(LEFT$(d$,2))
day% = VAL(mid$(D$,4,2))
year% = VAL(RIGHT$(d$,4))
mdy month%,day%,year%
firstdate& = julian&
julian& = 0
d$ = ""
d$ = text2$
d$ = RTRIM$(d$)
month% = VAL(LEFT$(d$,2))
day% = VAL(mid$(D$,4,2))
year% = VAL(RIGHT$(d$,4))
mdy month%,day%,year%
secondDate& = julian&
timespan% = secondDate&-firstdate&
IF timespan% > 365 THEN errormsg
counter% = 0
'***** read records and save record numbers that are a date match ******************
OPEN "store.dta" FOR OUTPUT AS #2
FOR j% = 1 TO acctrec%
GET #14,j%
IF VAL(record_date$) >= firstdate& THEN
IF VAL(record_date$) <=secondDate& THEN
INCR counter%
WRITE #2,j%
END IF
END IF
NEXT
CLOSE #2,#14
IF counter% = 0 THEN
error_msg_date " SORRY, NO RECORDS FOUND FOR DATE(S) ENTERED!"
EXIT FAR
END IF
display_records text1$,text2$,firstdate&,secondDate&
END SUB
SUB error_msg_date (message$)
LOCAL a$
CLOSE
SOUND 150,.5
SOUND 234,.6
SOUND 150,.8
SOUND 234,1
popwindow 10,15,15,65,1,fnattr%(14,4),0,-5,0,""
ctext 12, message$,14,4
ctext 14 ,"PRESS ANY KEY...",14,4
a$ = INPUT$(1)
EXIT SUB
END SUB
SUB display_records(text1$,text2$,firstdate&,secondDate&)
SHARED client_name$,labor_chrg$,part_chrg$,tax_chrg$,record_date$,Grecords%
SHARED payment_type$,new_bal$,epa_chrg$,taxable$,client_record_number$
SHARED ar_payment_amount$,ar_payment_date$,ar_main_record_num$,acctrec%
SHARED ptr%,maxitem%,save%,julian&,true_date$,eptr%,emaxitem%,direction%
SHARED zclient_name$,zlabor_chrg$,zpart_chrg$,ztax_chrg$,zrecord_date$
SHARED zpayment_type$,zepa_chrg$,file_location%,ar_ptr%,exitflag%,zdiscount$
SHARED zname$,zamount$,zdate$,zptr%,zmaxitem%,return_flag%,zroapaid$,originalpay$
SHARED pick_line%,top_line%,record_nums%(),counter%,larr$()
LOCAL fileptr%,recnum%,labor!,parts!,tax!,epa!,total!,item$(),record%
LOCAL erow%,ecol%,count%,ar_payments_total!,ar_total!,j%,ar_count%,loopcount%
LOCAL max_name_len%,target_name%,diffrence%
max_name_len% = 0
target_name% = 0
diffrence% = 0
showdata:
file_location% = 0
ERASE record_nums%
DIM record_nums%(counter%)
OPEN "store.dta" FOR INPUT AS #2
fileptr% = 1
true_date$ = ""
'*********** read record numbers into an array *********************
DO UNTIL EOF(2)
INPUT #2,recnum%
record_nums%(fileptr%) = recnum%
INCR fileptr%
LOOP
CLOSE #2
roa_flag% = 0
totreceive! = 0
labor!=0
parts!=0
tax!=0
epa!=0
total!=0
total_ar!=0
ar_recv!=0
tot_discount! = 0
open_data_base
ERASE larr$
DIM larr$(counter%+1)
FOR j% = 1 TO counter%
GET #14,record_nums%(j%)
discount! = CVS(client_record_number$)
target_date& = 0
target_date& = VAL(record_date$)
julian.to.mdy target_date&,0,0,0,0
SELECT CASE payment_type$
CASE "1"
howpayed$ = "CASH"
CASE "2"
howpayed$ = "CHRG"
INCR total_ar!,(CVS(labor_chrg$)+CVS(part_chrg$)+CVS(tax_chrg$)+CVS(epa_chrg$))
CASE "3"
howpayed$ = "CHEC"
CASE "4"
howpayed$ = "M/CD"
CASE "5"
howpayed$ = "VISA"
CASE "6"
howpayed$ = "DISC"
CASE "7"
howpayed$ = "AMEX"
CASE "8"
howpayed$ = "R/OA"
INCR roa_flag%
END SELECT
d$ = true_date$
month$ = LEFT$(d$,2)
day$ = mid$(D$,4,2)
year$ = RIGHT$(d$,4)
year$ = RIGHT$(year$,2)
d$ = month$+"-"+day$+"-"+year$
p_cliname$ = client_name$
clname$ =LEFT$(client_name$,14)
' IF RTRIM$(howpayed$) = "R/OA" THEN GOTO no_tot
linetot! = (CVS(epa_chrg$)+CVS(tax_chrg$)+CVS(labor_chrg$)+CVS(part_chrg$)) - discount!
' no_tot:
larr$(j%) = d$+" "+clname$+" "+ USING$("####.##",CVS(ar_payment_amount$))+" "+USING$("#####.##",(CVS(labor_chrg$)+CVS(part_chrg$))) _
+" "+USING$("####.##",CVS(tax_chrg$))+" "+USING$("####.##",CVS(epa_chrg$))+" "+USING$("######.##",linetot!) _
+" "+howpayed$
INCR labor!,CVS(labor_chrg$)
INCR parts!,CVS(part_chrg$)
INCR tax!,CVS(tax_chrg$)
INCR epa!,CVS(epa_chrg$)
INCR ar_recv!,CVS(ar_payment_amount$)
INCR tot_discount!,discount!
NEXT
labor! = ROUND(labor!,2)
parts! = ROUND(parts!,2)
tax! = ROUND(tax!,2)
epa! = ROUND(epa!,2)
ar_recv! = ROUND(ar_recv!,2)
tot_discount! = ROUND(tot_discount!,2)
'total! = (labor!+parts!+tax!+epa!+ar_recv!)
total! = (labor!+parts!+tax!+epa!)-tot_discount!
totreceive! = (total!+ar_recv!) -total_ar!
totreceive! = ROUND(totreceive!,2)
'total! = total!+ar_recv!+total_ar!
'total! = total!+total_ar!
CLOSE #14
COLOR 7,1
CLS
xqprint SPACE$(80) ,1,1,fnattr%(7,4)
ctext 1,"SALES REPORT FOR THE PERIOD "+text1$+" TO "+text2$,7,4
xqprint STRING$(80,196),2,1,fnattr%(7,1)
xqprint "DATE NAME A/R PARTS&LABOR TAX EPA TOTAL PAID",3,1,fnattr%(7,1)
xqprint STRING$(80,196),4,1,fnattr%(7,1)
popwindow 19,2,23,79,1,fnattr%(15,1),0,0,0,""
xqprint STRING$(78,196),20,2,fnattr%(15,1)
xqprint " LABOR PARTS TAX EPA CHRG RCVD ON ACCT",19,2,fnattr%(15,1)
Xqprint USING$("######.##",labor!)+" "+USING$("######.##",parts!) _
+" "+USING$("####.##",tax!)+" "+USING$("####.##",epa!) _
+" "+USING$("######.##",total_ar!)+" "+USING$("######.##",ar_recv!),21,2,fnattr%(15,1)
xqprint STRING$(78,196),22,2,fnattr%(15,1)
'ctext 23,"Total Sales = "+LTRIM$(USING$("######.##",total!))+" Total Rcvd = "+LTRIM$(USING$("######.##",totreceive!))+" (TOTAL + R/OA) - CHRG",15,1
total! = ROUND(total!,2):tot_discount! = ROUND(tot_discount!,2)
ctext 23,"SALES = "+LTRIM$(USING$("######.##",total!))+" COLLECTED = "+LTRIM$(USING$("######.##",totreceive!))+" DISCOUNTS = "+USING$("#####.##",tot_discount!),15,1
aro# = total! / (counter%-roa_flag%)
num_of_ta$ = STR$(counter%-roa_flag%)
num_of_ta$=LTRIM$(num_of_ta$)
average$ = USING$("#####.##",aro#)
average$ = LTRIM$(average$)
xqprint "[ "+num_of_ta$+" ENTRIES AVERAGING "+average$+" ]",2,45,fnattr%(7,1)
labor!=0
parts!=0
tax!=0
epa!=0
total!=0
page% = 1
'xqprint "PAGE "+STR$(page%),1,2,fnattr%(7,1)
xqprint " ALT+F1=CALCULATOR ESC=NEW ENTER=EDIT F2=ADD F4=A/R F5=DELETE F6=PRINT ",25,2,fnattr%(7,1)
Yy%=0
editflag% = 0
DO
INCR Yy%
IF LEN(LARR$(Yy%)) > MaxLen% THEN MaxLen%=LEN(LARR$(Yy%))
IF LEN(LARR$(Yy%)) = 0 THEN ListLen%=Yy%: EXIT LOOP
LOOP
COLOR 7,1
strenleng% = LEN(larr$(yy%))
WinTop%=4:WinLeft%=1
WinBot% = (WinTop% +1+ Yy%)-1:If WinBot% > 18 THEN WinBot% = 18
TopLine% = 0 ' the first element to appear inside the box
PickLine% = 1 ' the offset box line you are pointing at
DO ' Main loop start
For Yy% = WinTop%+1 TO winbot%-1
IF Yy% = WinTop% + PickLine% THEN
IF INSTR(larr$(Yy%-WinTop%+TopLine%),"CHRG") THEN
f% = 4:b%=7
ELSE
f%=1:b%=7
END IF
ELSE
IF INSTR(larr$(Yy%-WinTop%+TopLine%),"CHRG") THEN
f%=12:b% = 1
ELSE
f% = 7:b% = 1
END IF
END IF
xqprint LEFT$(LARR$(Yy%-WinTop%+TopLine%),80) ,yy%,1,fnattr%(f%,b%)
Next Yy%
DO:A$=INKEY$
LOCATE 1,1
LOOP WHILE A$=""
SELECT CASE A$
CASE CHR$(0,104) 'ALT F1
EXIT FAR AT ret_from_scalc
s_calc$ = savescreen$
scalc
ret_from_scalc:
LOCATE 1,1,0
restorescreen s_calc$
GOTO endloop
CASE CHR$(0,61)
CLOSE
REDIM larr$(counter%+1)
ERASE larr$,record_nums%
MEMPACK
RUN "start.exe"
CASE CHR$(0,&H49) 'page up
IF PickLine%=1 then _
TopLine%=TopLine%-(WinBot%-winTop%)+2 else _
PickLine%=1
CASE CHR$(0,&H51) 'page dn
IF PickLine%=WinBot%-WinTop%-1 THEN _
TopLine%=TopLine%+(WinBot%-WinTop%)-2 else _
PickLine%=WinBot%-WinTop%-1
CASE CHR$(0,&H48) 'up arrow
DECR PickLine%
CASE CHR$(0,&H50) 'dn arrow
INCR PickLine%
CASE CHR$(0,63)
CLOSE
open_data_base
GET #14, record_nums%(topline%+pickline%)
name_of_owner$ = RTRIM$(client_Name$)
IF payment_type$ = "2" THEN
FOR check_ar_flag% = 1 TO acctrec%
GET #14,check_ar_flag%
IF VAL(ar_main_record_num$) = record_nums%(topline%+pickline%) THEN
del$ = savescreen$
popwindow 8,18,11,62,1,fnattr%(0,3),0,0,0,""
ctext 8,"RECORD OWNER -> "+name_of_owner$,0,3
error_msg_date "CANNOT DELETE! RECORD HAS PAYMENT HISTORY!"
restorescreen del$
CLOSE
GOTO endloop
END IF
NEXT
END IF
doYouWantToDoThis 1
IF return_flag% = 1 THEN
restorescreen del$
CLOSE
GOTO endloop
END IF
rec_num% = (record_nums%(topline%+pickline%))
ERASE larr$,record_nums%
delete_record rec_num%
CASE CHR$(0,64)
print_report larr$(),record_nums%(),firstdate&,secondDate&
GOTO endloop
CASE CHR$(27)
CLOSE
OPEN "store.dta" FOR OUTPUT AS #2 ' delete the sequential file
ERASE record_nums%
CLOSE #2
EXIT FAR
CASE CHR$(13)
SELECT CASE Grecords%
CASE > 0
passwrd 1
CASE 0
EXIT SELECT
END SELECT
shared change%
s$ = savescreen$
open_data_base
file_location% = record_nums%(topline%+pickline%)
discount_! = 0
GET #14,file_location%
discount_! = CVS(client_record_number$)
ehowpayed$ = ""
zpayment_type$ = ""
originalpay$ = ""
originalpay$ = payment_type$
SELECT CASE payment_type$
CASE "1"
ehowpayed$ = "CASH"
CASE "2"
ehowpayed$ = "CHRG"
CASE "3"
ehowpayed$ = "CHEC"
CASE "4"
ehowpayed$ = "M/CD"
CASE "5"
ehowpayed$ = "VISA"
CASE "6"
ehowpayed$ = "DISC"
CASE "7"
ehowpayed$ = "AMEX"
CASE "8"
ehowpayed$ = "R/OA"
END SELECT
SELECT CASE ehowpayed$
CASE "BIGBUNCHOFBULLSHIT"
del$ = savescreen$
popwindow 8,18,11,62,1,fnattr%(0,3),0,0,0,""
owner$ = RTRIM$(client_Name$)
IF RTRIM$(owner$) = "" THEN owner$ = "A/R Module"
ctext 8,"RECORD OWNER -> "+owner$,0,3
error_msg_date "ERROR! - CAN'T EDIT R/OA ENTRYS HERE!
restorescreen del$
CLOSE #14
GOTO endloop
CASE ELSE
top_msg$ = "EDIT SALES ENTRY"
END SELECT
xqprint SPACE$(79),25,1,fnattr%(7,1)
popwindow 6,15,18,65,2,fnattr%(14,1),0,0,0,""
ctext 7,STRING$(51,196),7,1
ctext 6,top_msg$,7,1
GET #14,file_location%
eptr% = 1
emaxitem% = 8
zlabor_chrg! = 0
zpart_chrg! = 0
ztax_chrg! = 0
zepa_chrg! = 0
zclient_name$ = client_name$
zlabor_chrg! = CVS(labor_chrg$)
zpart_chrg! = CVS(part_chrg$)
ztax_chrg! = CVS(tax_chrg$)
zepa_chrg! = CVS(epa_chrg$)
zlabor_chrg$ = USING$("#####.##",CVS(labor_chrg$))
zpart_chrg$ = USING$("#####.##",CVS(part_chrg$))
ztax_chrg$ = USING$("#####.##",CVS(tax_chrg$))
zepa_chrg$ = USING$("#####.##",CVS(epa_chrg$))
zlabor_chrg$ = LTRIM$(zlabor_chrg$)+SPACE$(4)
zpart_chrg$ = LTRIM$(zpart_chrg$)+SPACE$(4)
ztax_chrg$ = LTRIM$(ztax_chrg$)+SPACE$(4)
zepa_chrg$ = LTRIM$(zepa_chrg$)+SPACE$(4)
zroapaid$ = USING$("#####.##",CVS(ar_payment_amount$))
zroapaid$ = LTRIM$(zroapaid$)+SPACE$(4)
'************ convert julian date to calendar date ***************
target_date& = 0
target_date& = VAL(record_date$)
julian.to.mdy target_date&,0,0,0,0
zrecord_date$ = true_date$
IF discount_! > 0 THEN
xqprint "DISCOUNT : "+USING$("-###.##",discount_!),8,15,fnattr%(12,1)
END IF
xqprint "CLIENT : "+zclient_name$,9,15,fnattr%(7,1)
xqprint "DATE : "+zrecord_date$,10,15,fnattr%(7,1)
xqprint "PAID : "+ehowpayed$,11,15,fnattr%(7,1)
xqprint "LABOR : "+zlabor_chrg$,12,15,fnattr%(7,1)
xqprint "PARTS : "+zpart_chrg$,13,15,fnattr%(7,1)
xqprint "TAX : "+ztax_chrg$,14,15,fnattr%(7,1)
xqprint "EPA : "+zepa_chrg$,15,15,fnattr%(7,1)
xqprint "R/OA : "+zroapaid$,16,15,fnattr%(7,1)
ctext 17,STRING$(51,196),7,1
ctext 18,"F2=SAVE CHANGES ESC=EXIT",7,1
ecol% = 26
change% = 0
DO
SELECT CASE eptr%
CASE 1
erow%= 9
editoneline zclient_name$,erow%,ecol%,lineLen%, editkey%, 7,0
CASE 2
erow%= 10
editoneline zrecord_date$,erow%,ecol%,lineLen%, editkey%, 7,0
CASE 3
erow%= 11
pop$ = savescreen$
DIM item$(9)
item$(1) = " CASH "
item$(2) = " CHRG "
item$(3) = " CHEC "
item$(4) = " M/CD "
item$(5) = " VISA "
item$(6) = " DISC "
item$(7) = " AMEX "
item$(8) = " R/OA "
item$(9) = " EXIT "
subscript% = 1
curntpos% = 1
itemcount% = UBOUND(item$(1))
row% = 8
col% = 50
downto% = row%+itemcount%
outTo% = LEN(item$(1))+col%-1
bordr% = 1
attr% = fnattr%(14,4)
mhattr% = fnattr%(0,7)
PopWindow row%,col%,downto%-1,outTo%,bordr%, attr%, 0, -5, 10, ""
for mloop% = 1 to itemcount%
xqprint item$(mloop%),mloop%+row%-1,col%,attr%
next
xqprint item$(1),row%,col%,mhattr%
DO
WHILE NOT INSTAT
WEND
ans$=inkey$
SELECT CASE ans$
CASE chr$(0,72)
xqprint item$(subscript%),curntpos%-1+row%,col%,attr%
DECR curntpos%
DECR subscript%
IF subscript% < 1 THEN
ERASE item$
LOCATE 1,1,0
restorescreen pop$
GOTO 101
END IF
IF curntpos% < 1 THEN
ERASE item$
LOCATE 1,1,0
restorescreen pop$
GOTO 101
END IF
CASE chr$(0,80)
xqprint item$(subscript%),curntpos%-1+row%,col%,attr%
INCR curntpos%
INCR subscript%
IF subscript% > UBOUND(item$(1)) THEN
ERASE item$
LOCATE 1,1,0
restorescreen pop$
GOTO 101
END IF
IF curntpos% > UBOUND(item$(1)) THEN
ERASE item$
LOCATE 1,1,0
restorescreen pop$
GOTO 101
END IF
CASE CHR$(27)
ERASE item$
LOCATE 1,1,0
restorescreen s$
GOTO endloop
CASE chr$(13)
SELECT CASE curntpos%
CASE 1
zpayment_type$ = "1"
change% = 1
GOTO 101
CASE 2
zpayment_type$ = "2"
change% = 1
GOTO 101
CASE 3
zpayment_type$ = "3"
change% = 1
GOTO 101
CASE 4
zpayment_type$ = "4"
change% = 1
GOTO 101
CASE 5
zpayment_type$ = "5"
change% = 1
GOTO 101
CASE 6
zpayment_type$ = "6"
change% = 1
GOTO 101
CASE 7
zpayment_type$ = "7"
change% = 1
GOTO 101
CASE 8
zpayment_type$ = "8"
change% = 1
GOTO 101
CASE 9
GOTO 101
END SELECT
END SELECT
xqprint item$(subscript%),curntpos%+row%-1,col%,mhattr%
LOOP
101:
ERASE item$
SELECT CASE direction% ' ********* determine if your going up or down ***********
CASE 1
eptr% = 2
CASE 2
eptr% = 4
END SELECT
restorescreen pop$
LOCATE erow%,ecol%:
COLOR 7,1
SELECT CASE zpayment_type$
CASE "1"
PRINT "CASH"
CASE "2"
PRINT "CHRG"
CASE "3"
PRINT "CHEC"
CASE "4"
PRINT "M/CD"
CASE "5"
PRINT "VISA"
CASE "6"
PRINT "DISC"
CASE "7"
PRINT "AMEX"
CASE "8"
PRINT "R/OA"
END SELECT
'editoneline zpayment_type$,erow%,ecol%,lineLen%, editkey%, 7,0
restorescreen pop$
CASE 4
erow%= 12
editoneline zlabor_chrg$,erow%,ecol%,lineLen%, editkey%, 7,0
CASE 5
erow%= 13
editoneline zpart_chrg$,erow%,ecol%,lineLen%, editkey%, 7,0
CASE 6
erow%= 14
editoneline ztax_chrg$,erow%,ecol%,lineLen%, editkey%, 7,0
CASE 7
erow%= 15
editoneline zepa_chrg$,erow%,ecol%,lineLen%, editkey%, 7,0
CASE 8
erow%= 16
editoneline zroapaid$,erow%,ecol%,lineLen%, editkey%, 7,0
END SELECT
'*************** exit edit procedure ******************
IF eptr% = 100 THEN
restorescreen s$
REDIM larr$(counter%+1)
REDIM record_nums%(counter%)
ERASE item$, record_nums%,larr$
CLOSE
LOCATE 1,1,0
EXIT FAR
END IF
IF eptr% = 50 THEN
restorescreen s$
CLOSE #14
LOCATE 1,1,0
GOTO endloop
END IF
LOOP
CASE CHR$(0,62)
CLOSE
REDIM larr$(counter%+1)
ERASE larr$,record_nums%
MEMPACK
CHAIN "ar.pbc"
CASE CHR$(0,60)
s$ = savescreen$
xqprint SPACE$(79),25,1,fnattr%(7,1)
popwindow 6,15,19,65,1,fnattr%(14,1),0,-5,0,""
xqprint STRING$(51,196),7,15,fnattr%(7,1)
ctext 6,"ENTER SALES TRANSACTION",7,1
eptr% = 1
emaxitem% = 8
zclient_name$ = SPACE$(25)
zlabor_chrg$ = SPACE$(12)
zpart_chrg$ = SPACE$(12)
ztax_chrg$ = SPACE$(10)
zepa_chrg$ = SPACE$(10)
zrecord_date$ = DATE$
zpayment_type$ = SPACE$(12)
zdiscount$ = SPACE$(20)
xqprint "CLIENT : "+zclient_name$,9,15,fnattr%(7,1)
xqprint "DATE : "+zrecord_date$,10,15,fnattr%(7,1)
xqprint "PAID : "+zpayment_type$,11,15,fnattr%(7,1)
xqprint "LABOR : "+zlabor_chrg$,12,15,fnattr%(7,1)
xqprint "PARTS : "+zpart_chrg$,13,15,fnattr%(7,1)
xqprint "TAX : "+ztax_chrg$,14,15,fnattr%(7,1)
xqprint "EPA : "+zepa_chrg$,15,15,fnattr%(7,1)
xqprint "DISCOUNT : "+zdiscount$,16,15,fnattr%(7,1)
xqprint STRING$(51,196),18,15,fnattr%(7,1)
ctext 19,"F2=SAVE RECORD ESC=EXIT",7,1
ecol% = 26
direction% = 0
DO
SELECT CASE eptr%
CASE 1
erow%= 9
editentry zclient_name$,erow%,ecol%,lineLen%, editkey%, 7,0
CASE 2
erow%= 10
editentry zrecord_date$,erow%,ecol%,lineLen%, editkey%, 7,0
CASE 3
erow%= 11
'***************** display spelling of payment types ***********
pop$ = savescreen$
DIM item$(9)
item$(1) = " CASH "
item$(2) = " CHRG "
item$(3) = " CHEC "
item$(4) = " M/CD "
item$(5) = " VISA "
item$(6) = " DISC "
item$(7) = " AMEX "
item$(8) = " R/OA "
item$(9) = " EXIT "
subscript% = 1
curntpos% = 1
itemcount% = UBOUND(item$(1))
row% = 8
col% = 50
downto% = row%+itemcount%
outTo% = LEN(item$(1))+col%-1
bordr% = 1
attr% = fnattr%(14,4)
mhattr% = fnattr%(0,7)
PopWindow row%,col%,downto%-1,outTo%,bordr%, attr%, 0, -5, 10, ""
for mloop% = 1 to itemcount%
xqprint item$(mloop%),mloop%+row%-1,col%,attr%
next
xqprint item$(1),row%,col%,mhattr%
DO
WHILE NOT INSTAT
WEND
ans$=inkey$
SELECT CASE ans$
CASE chr$(0,72)
xqprint item$(subscript%),curntpos%-1+row%,col%,attr%
DECR curntpos%
DECR subscript%
IF subscript% < 1 THEN subscript% = UBOUND(item$(1))
IF curntpos% < 1 THEN curntpos% = UBOUND(item$(1))
CASE chr$(0,80)
xqprint item$(subscript%),curntpos%-1+row%,col%,attr%
INCR curntpos%
INCR subscript%
IF subscript% > UBOUND(item$(1)) THEN subscript% = 1
IF curntpos% > UBOUND(item$(1)) THEN curntpos% = 1
CASE CHR$(27)
ERASE item$
restorescreen s$
GOTO endloop
CASE chr$(13)
SELECT CASE curntpos%
CASE 1
zpayment_type$ = "1"
GOTO 102
CASE 2
zpayment_type$ = "2"
GOTO 102
CASE 3
zpayment_type$ = "3"
GOTO 102
CASE 4
zpayment_type$ = "4"
GOTO 102
CASE 5
zpayment_type$ = "5"
GOTO 102
CASE 6
zpayment_type$ = "6"
GOTO 102
CASE 7
zpayment_type$ = "7"
GOTO 102
CASE 8
zpayment_type$ = "8"
GOTO 102
CASE 9
GOTO 102
END SELECT
END SELECT
xqprint item$(subscript%),curntpos%+row%-1,col%,mhattr%
Moonglow
Diamond Member
It didn't do him any good to know how to code because they don't hire people like him...$IF 0
ﾚﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄｿ
ï½³ N O T I C E ï½³
ï½³ THIS PROGRAM BELONGS TO AND IS THE SOLE PROPERTY OFï½³
ï½³ IT IS CONSIDERED A TRADE SECRET AND IS NOT TO BE DIVULGED ï½³
ï½³ OR USED BY PARTIES WHO HAVE NOT RECEIVED WRITTEN AUTHORIZATION FROM ï½³
ï½³ THE OWNER. VIOLATERS WILL BE SEVERELY PUNISHED TO THE FULL EXTENT ï½³
ï½³ OF THE LAW. ALL LEGAL REMEDYS AND AVENUES WILL BE PURSUED RELENTLESSLY.ï½³
ï½³ NON-DISCLOSURE AGREEMENTS ARE AVAILABLE TO NECCESARY INDIVIDUALS. ï½³
ï½³ THANK YOU. ï½³
ﾀﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾄﾙ
$ENDIF
'module acct - accounting services
$COMPILE CHAIN
$STRING 4
$OPTION CNTLBREAK OFF
$ERROR ALL OFF
$STACK 5120
$OPTIMIZE SIZE
$CPU 80386
$DYNAMIC
$INCLUDE "\pb32\pbwindo.inc"
TIMER OFF
DEFINT a-z
OPtion base 1
COMMON recordnumber%, director%, var1%, var2%, var3%, var4%, var5%, partarray$( 1 ), _
top_line%,pick_line%,Gco.name$,Gceo$,Gaddress$,Gcity$,Gcounty$,Gstate$,Gzip$,Gphone1$,Gphone2$, _
Gdpercent$,Gfed$,Gtaxrate$,Gpassword$,Gpc$,Gepafee$,Glabortax$, _
Gpercenttot$,Gmaxepa$,Glabortaxrate$,Gscreensaverdelay$,Gscreensavetype$, _
Gallow_dos_access$,Gtempvar1$,Gtempvar2$,Gtempvar3$,Gid$(1),Gpass$(1),Gaccess$(1),Grecords%
clearkbd
'var1% = 1
%true = -1
%false = 0
password_is_checked% = %false
callflag% = %false
EXIT FAR AT startprog
startprog:
IF var1% THEN
callflag% = %true
cut_records
END IF
SELECT CASE Grecords%
CASE > 0
IF password_is_checked% = %false THEN passwrd 1
CASE 0
EXIT SELECT
END SELECT
start
END
SUB start
SHARED client_name$,labor_chrg$,part_chrg$,tax_chrg$,record_date$
SHARED payment_type$,new_bal$,epa_chrg$,taxable$,client_record_number$
SHARED ar_payment_amount$,ar_payment_date$,ar_main_record_num$,acctrec%
SHARED ptr%,maxitem%,save%,julian&,eptr%,emaxitem%,counter%
SHARED recordnumber%, director%, var1%, var2%, var3%, var4%, var5%, partarray$()
SHARED larr$(),record_nums%()
LOCAL j%
COLOR 7,1
CLS
save% = 0 'control exit from loop to start search
text1$ = DATE$
text2$ = DATE$
s$ = savescreen$
popwindow 10,20,14,60,4,fnattr%(7,1),0,-5,0,""
COLOR 0,7
LOCATE 12,26
LOCATE 12,45
FIRST$ = SAVESCREEN$
xqprint SPACE$(22)+"ENTER DATES - F2=START ESC=EXIT F4=A/R"+SPACE$(22),25,1,fnattr%(9,0)
maxitem% = 2
ptr% = 1
'****************** get date range to look at records from *********************
DO
SELECT CASE ptr%
CASE 1
row% = 12:col% = 26
lineEdit text1$, row%, col%, lineLen%, editkey%, 0, 7
CASE 2
row% = 12:col% = 45
lineEdit text2$, row%, col%, lineLen%, editkey%, 0, 7
END SELECT
IF save% = 1 THEN EXIT DO
LOOP
LOCATE 1,1,0
ctext 14,"<< CREATING REPORT >>",23,1
open_data_base
IF acctrec% < 500 THEN
DELAY 1.5
END IF
julian& = 0
firstdate& = 0
secondDate& = 0
d$ = ""
d$ = text1$
d$ = RTRIM$(d$)
month% = VAL(LEFT$(d$,2))
day% = VAL(mid$(D$,4,2))
year% = VAL(RIGHT$(d$,4))
mdy month%,day%,year%
firstdate& = julian&
julian& = 0
d$ = ""
d$ = text2$
d$ = RTRIM$(d$)
month% = VAL(LEFT$(d$,2))
day% = VAL(mid$(D$,4,2))
year% = VAL(RIGHT$(d$,4))
mdy month%,day%,year%
secondDate& = julian&
timespan% = secondDate&-firstdate&
IF timespan% > 365 THEN errormsg
counter% = 0
'***** read records and save record numbers that are a date match ******************
OPEN "store.dta" FOR OUTPUT AS #2
FOR j% = 1 TO acctrec%
GET #14,j%
IF VAL(record_date$) >= firstdate& THEN
IF VAL(record_date$) <=secondDate& THEN
INCR counter%
WRITE #2,j%
END IF
END IF
NEXT
CLOSE #2,#14
IF counter% = 0 THEN
error_msg_date " SORRY, NO RECORDS FOUND FOR DATE(S) ENTERED!"
EXIT FAR
END IF
display_records text1$,text2$,firstdate&,secondDate&
END SUB
SUB error_msg_date (message$)
LOCAL a$
CLOSE
SOUND 150,.5
SOUND 234,.6
SOUND 150,.8
SOUND 234,1
popwindow 10,15,15,65,1,fnattr%(14,4),0,-5,0,""
ctext 12, message$,14,4
ctext 14 ,"PRESS ANY KEY...",14,4
a$ = INPUT$(1)
EXIT SUB
END SUB
SUB display_records(text1$,text2$,firstdate&,secondDate&)
SHARED client_name$,labor_chrg$,part_chrg$,tax_chrg$,record_date$,Grecords%
SHARED payment_type$,new_bal$,epa_chrg$,taxable$,client_record_number$
SHARED ar_payment_amount$,ar_payment_date$,ar_main_record_num$,acctrec%
SHARED ptr%,maxitem%,save%,julian&,true_date$,eptr%,emaxitem%,direction%
SHARED zclient_name$,zlabor_chrg$,zpart_chrg$,ztax_chrg$,zrecord_date$
SHARED zpayment_type$,zepa_chrg$,file_location%,ar_ptr%,exitflag%,zdiscount$
SHARED zname$,zamount$,zdate$,zptr%,zmaxitem%,return_flag%,zroapaid$,originalpay$
SHARED pick_line%,top_line%,record_nums%(),counter%,larr$()
LOCAL fileptr%,recnum%,labor!,parts!,tax!,epa!,total!,item$(),record%
LOCAL erow%,ecol%,count%,ar_payments_total!,ar_total!,j%,ar_count%,loopcount%
LOCAL max_name_len%,target_name%,diffrence%
max_name_len% = 0
target_name% = 0
diffrence% = 0
showdata:
file_location% = 0
ERASE record_nums%
DIM record_nums%(counter%)
OPEN "store.dta" FOR INPUT AS #2
fileptr% = 1
true_date$ = ""
'*********** read record numbers into an array *********************
DO UNTIL EOF(2)
INPUT #2,recnum%
record_nums%(fileptr%) = recnum%
INCR fileptr%
LOOP
CLOSE #2
roa_flag% = 0
totreceive! = 0
labor!=0
parts!=0
tax!=0
epa!=0
total!=0
total_ar!=0
ar_recv!=0
tot_discount! = 0
open_data_base
ERASE larr$
DIM larr$(counter%+1)
FOR j% = 1 TO counter%
GET #14,record_nums%(j%)
discount! = CVS(client_record_number$)
target_date& = 0
target_date& = VAL(record_date$)
julian.to.mdy target_date&,0,0,0,0
SELECT CASE payment_type$
CASE "1"
howpayed$ = "CASH"
CASE "2"
howpayed$ = "CHRG"
INCR total_ar!,(CVS(labor_chrg$)+CVS(part_chrg$)+CVS(tax_chrg$)+CVS(epa_chrg$))
CASE "3"
howpayed$ = "CHEC"
CASE "4"
howpayed$ = "M/CD"
CASE "5"
howpayed$ = "VISA"
CASE "6"
howpayed$ = "DISC"
CASE "7"
howpayed$ = "AMEX"
CASE "8"
howpayed$ = "R/OA"
INCR roa_flag%
END SELECT
d$ = true_date$
month$ = LEFT$(d$,2)
day$ = mid$(D$,4,2)
year$ = RIGHT$(d$,4)
year$ = RIGHT$(year$,2)
d$ = month$+"-"+day$+"-"+year$
p_cliname$ = client_name$
clname$ =LEFT$(client_name$,14)
' IF RTRIM$(howpayed$) = "R/OA" THEN GOTO no_tot
linetot! = (CVS(epa_chrg$)+CVS(tax_chrg$)+CVS(labor_chrg$)+CVS(part_chrg$)) - discount!
' no_tot:
larr$(j%) = d$+" "+clname$+" "+ USING$("####.##",CVS(ar_payment_amount$))+" "+USING$("#####.##",(CVS(labor_chrg$)+CVS(part_chrg$))) _
+" "+USING$("####.##",CVS(tax_chrg$))+" "+USING$("####.##",CVS(epa_chrg$))+" "+USING$("######.##",linetot!) _
+" "+howpayed$
INCR labor!,CVS(labor_chrg$)
INCR parts!,CVS(part_chrg$)
INCR tax!,CVS(tax_chrg$)
INCR epa!,CVS(epa_chrg$)
INCR ar_recv!,CVS(ar_payment_amount$)
INCR tot_discount!,discount!
NEXT
labor! = ROUND(labor!,2)
parts! = ROUND(parts!,2)
tax! = ROUND(tax!,2)
epa! = ROUND(epa!,2)
ar_recv! = ROUND(ar_recv!,2)
tot_discount! = ROUND(tot_discount!,2)
'total! = (labor!+parts!+tax!+epa!+ar_recv!)
total! = (labor!+parts!+tax!+epa!)-tot_discount!
totreceive! = (total!+ar_recv!) -total_ar!
totreceive! = ROUND(totreceive!,2)
'total! = total!+ar_recv!+total_ar!
'total! = total!+total_ar!
CLOSE #14
COLOR 7,1
CLS
xqprint SPACE$(80) ,1,1,fnattr%(7,4)
ctext 1,"SALES REPORT FOR THE PERIOD "+text1$+" TO "+text2$,7,4
xqprint STRING$(80,196),2,1,fnattr%(7,1)
xqprint "DATE NAME A/R PARTS&LABOR TAX EPA TOTAL PAID",3,1,fnattr%(7,1)
xqprint STRING$(80,196),4,1,fnattr%(7,1)
popwindow 19,2,23,79,1,fnattr%(15,1),0,0,0,""
xqprint STRING$(78,196),20,2,fnattr%(15,1)
xqprint " LABOR PARTS TAX EPA CHRG RCVD ON ACCT",19,2,fnattr%(15,1)
Xqprint USING$("######.##",labor!)+" "+USING$("######.##",parts!) _
+" "+USING$("####.##",tax!)+" "+USING$("####.##",epa!) _
+" "+USING$("######.##",total_ar!)+" "+USING$("######.##",ar_recv!),21,2,fnattr%(15,1)
xqprint STRING$(78,196),22,2,fnattr%(15,1)
'ctext 23,"Total Sales = "+LTRIM$(USING$("######.##",total!))+" Total Rcvd = "+LTRIM$(USING$("######.##",totreceive!))+" (TOTAL + R/OA) - CHRG",15,1
total! = ROUND(total!,2):tot_discount! = ROUND(tot_discount!,2)
ctext 23,"SALES = "+LTRIM$(USING$("######.##",total!))+" COLLECTED = "+LTRIM$(USING$("######.##",totreceive!))+" DISCOUNTS = "+USING$("#####.##",tot_discount!),15,1
aro# = total! / (counter%-roa_flag%)
num_of_ta$ = STR$(counter%-roa_flag%)
num_of_ta$=LTRIM$(num_of_ta$)
average$ = USING$("#####.##",aro#)
average$ = LTRIM$(average$)
xqprint "[ "+num_of_ta$+" ENTRIES AVERAGING "+average$+" ]",2,45,fnattr%(7,1)
labor!=0
parts!=0
tax!=0
epa!=0
total!=0
page% = 1
'xqprint "PAGE "+STR$(page%),1,2,fnattr%(7,1)
xqprint " ALT+F1=CALCULATOR ESC=NEW ENTER=EDIT F2=ADD F4=A/R F5=DELETE F6=PRINT ",25,2,fnattr%(7,1)
Yy%=0
editflag% = 0
DO
INCR Yy%
IF LEN(LARR$(Yy%)) > MaxLen% THEN MaxLen%=LEN(LARR$(Yy%))
IF LEN(LARR$(Yy%)) = 0 THEN ListLen%=Yy%: EXIT LOOP
LOOP
COLOR 7,1
strenleng% = LEN(larr$(yy%))
WinTop%=4:WinLeft%=1
WinBot% = (WinTop% +1+ Yy%)-1:If WinBot% > 18 THEN WinBot% = 18
TopLine% = 0 ' the first element to appear inside the box
PickLine% = 1 ' the offset box line you are pointing at
DO ' Main loop start
For Yy% = WinTop%+1 TO winbot%-1
IF Yy% = WinTop% + PickLine% THEN
IF INSTR(larr$(Yy%-WinTop%+TopLine%),"CHRG") THEN
f% = 4:b%=7
ELSE
f%=1:b%=7
END IF
ELSE
IF INSTR(larr$(Yy%-WinTop%+TopLine%),"CHRG") THEN
f%=12:b% = 1
ELSE
f% = 7:b% = 1
END IF
END IF
xqprint LEFT$(LARR$(Yy%-WinTop%+TopLine%),80) ,yy%,1,fnattr%(f%,b%)
Next Yy%
DO:A$=INKEY$
LOCATE 1,1
LOOP WHILE A$=""
SELECT CASE A$
CASE CHR$(0,104) 'ALT F1
EXIT FAR AT ret_from_scalc
s_calc$ = savescreen$
scalc
ret_from_scalc:
LOCATE 1,1,0
restorescreen s_calc$
GOTO endloop
CASE CHR$(0,61)
CLOSE
REDIM larr$(counter%+1)
ERASE larr$,record_nums%
MEMPACK
RUN "start.exe"
CASE CHR$(0,&H49) 'page up
IF PickLine%=1 then _
TopLine%=TopLine%-(WinBot%-winTop%)+2 else _
PickLine%=1
CASE CHR$(0,&H51) 'page dn
IF PickLine%=WinBot%-WinTop%-1 THEN _
TopLine%=TopLine%+(WinBot%-WinTop%)-2 else _
PickLine%=WinBot%-WinTop%-1
CASE CHR$(0,&H48) 'up arrow
DECR PickLine%
CASE CHR$(0,&H50) 'dn arrow
INCR PickLine%
CASE CHR$(0,63)
CLOSE
open_data_base
GET #14, record_nums%(topline%+pickline%)
name_of_owner$ = RTRIM$(client_Name$)
IF payment_type$ = "2" THEN
FOR check_ar_flag% = 1 TO acctrec%
GET #14,check_ar_flag%
IF VAL(ar_main_record_num$) = record_nums%(topline%+pickline%) THEN
del$ = savescreen$
popwindow 8,18,11,62,1,fnattr%(0,3),0,0,0,""
ctext 8,"RECORD OWNER -> "+name_of_owner$,0,3
error_msg_date "CANNOT DELETE! RECORD HAS PAYMENT HISTORY!"
restorescreen del$
CLOSE
GOTO endloop
END IF
NEXT
END IF
doYouWantToDoThis 1
IF return_flag% = 1 THEN
restorescreen del$
CLOSE
GOTO endloop
END IF
rec_num% = (record_nums%(topline%+pickline%))
ERASE larr$,record_nums%
delete_record rec_num%
CASE CHR$(0,64)
print_report larr$(),record_nums%(),firstdate&,secondDate&
GOTO endloop
CASE CHR$(27)
CLOSE
OPEN "store.dta" FOR OUTPUT AS #2 ' delete the sequential file
ERASE record_nums%
CLOSE #2
EXIT FAR
CASE CHR$(13)
SELECT CASE Grecords%
CASE > 0
passwrd 1
CASE 0
EXIT SELECT
END SELECT
shared change%
s$ = savescreen$
open_data_base
file_location% = record_nums%(topline%+pickline%)
discount_! = 0
GET #14,file_location%
discount_! = CVS(client_record_number$)
ehowpayed$ = ""
zpayment_type$ = ""
originalpay$ = ""
originalpay$ = payment_type$
SELECT CASE payment_type$
CASE "1"
ehowpayed$ = "CASH"
CASE "2"
ehowpayed$ = "CHRG"
CASE "3"
ehowpayed$ = "CHEC"
CASE "4"
ehowpayed$ = "M/CD"
CASE "5"
ehowpayed$ = "VISA"
CASE "6"
ehowpayed$ = "DISC"
CASE "7"
ehowpayed$ = "AMEX"
CASE "8"
ehowpayed$ = "R/OA"
END SELECT
SELECT CASE ehowpayed$
CASE "BIGBUNCHOFBULLSHIT"
del$ = savescreen$
popwindow 8,18,11,62,1,fnattr%(0,3),0,0,0,""
owner$ = RTRIM$(client_Name$)
IF RTRIM$(owner$) = "" THEN owner$ = "A/R Module"
ctext 8,"RECORD OWNER -> "+owner$,0,3
error_msg_date "ERROR! - CAN'T EDIT R/OA ENTRYS HERE!
restorescreen del$
CLOSE #14
GOTO endloop
CASE ELSE
top_msg$ = "EDIT SALES ENTRY"
END SELECT
xqprint SPACE$(79),25,1,fnattr%(7,1)
popwindow 6,15,18,65,2,fnattr%(14,1),0,0,0,""
ctext 7,STRING$(51,196),7,1
ctext 6,top_msg$,7,1
GET #14,file_location%
eptr% = 1
emaxitem% = 8
zlabor_chrg! = 0
zpart_chrg! = 0
ztax_chrg! = 0
zepa_chrg! = 0
zclient_name$ = client_name$
zlabor_chrg! = CVS(labor_chrg$)
zpart_chrg! = CVS(part_chrg$)
ztax_chrg! = CVS(tax_chrg$)
zepa_chrg! = CVS(epa_chrg$)
zlabor_chrg$ = USING$("#####.##",CVS(labor_chrg$))
zpart_chrg$ = USING$("#####.##",CVS(part_chrg$))
ztax_chrg$ = USING$("#####.##",CVS(tax_chrg$))
zepa_chrg$ = USING$("#####.##",CVS(epa_chrg$))
zlabor_chrg$ = LTRIM$(zlabor_chrg$)+SPACE$(4)
zpart_chrg$ = LTRIM$(zpart_chrg$)+SPACE$(4)
ztax_chrg$ = LTRIM$(ztax_chrg$)+SPACE$(4)
zepa_chrg$ = LTRIM$(zepa_chrg$)+SPACE$(4)
zroapaid$ = USING$("#####.##",CVS(ar_payment_amount$))
zroapaid$ = LTRIM$(zroapaid$)+SPACE$(4)
'************ convert julian date to calendar date ***************
target_date& = 0
target_date& = VAL(record_date$)
julian.to.mdy target_date&,0,0,0,0
zrecord_date$ = true_date$
IF discount_! > 0 THEN
xqprint "DISCOUNT : "+USING$("-###.##",discount_!),8,15,fnattr%(12,1)
END IF
xqprint "CLIENT : "+zclient_name$,9,15,fnattr%(7,1)
xqprint "DATE : "+zrecord_date$,10,15,fnattr%(7,1)
xqprint "PAID : "+ehowpayed$,11,15,fnattr%(7,1)
xqprint "LABOR : "+zlabor_chrg$,12,15,fnattr%(7,1)
xqprint "PARTS : "+zpart_chrg$,13,15,fnattr%(7,1)
xqprint "TAX : "+ztax_chrg$,14,15,fnattr%(7,1)
xqprint "EPA : "+zepa_chrg$,15,15,fnattr%(7,1)
xqprint "R/OA : "+zroapaid$,16,15,fnattr%(7,1)
ctext 17,STRING$(51,196),7,1
ctext 18,"F2=SAVE CHANGES ESC=EXIT",7,1
ecol% = 26
change% = 0
DO
SELECT CASE eptr%
CASE 1
erow%= 9
editoneline zclient_name$,erow%,ecol%,lineLen%, editkey%, 7,0
CASE 2
erow%= 10
editoneline zrecord_date$,erow%,ecol%,lineLen%, editkey%, 7,0
CASE 3
erow%= 11
pop$ = savescreen$
DIM item$(9)
item$(1) = " CASH "
item$(2) = " CHRG "
item$(3) = " CHEC "
item$(4) = " M/CD "
item$(5) = " VISA "
item$(6) = " DISC "
item$(7) = " AMEX "
item$(8) = " R/OA "
item$(9) = " EXIT "
subscript% = 1
curntpos% = 1
itemcount% = UBOUND(item$(1))
row% = 8
col% = 50
downto% = row%+itemcount%
outTo% = LEN(item$(1))+col%-1
bordr% = 1
attr% = fnattr%(14,4)
mhattr% = fnattr%(0,7)
PopWindow row%,col%,downto%-1,outTo%,bordr%, attr%, 0, -5, 10, ""
for mloop% = 1 to itemcount%
xqprint item$(mloop%),mloop%+row%-1,col%,attr%
next
xqprint item$(1),row%,col%,mhattr%
DO
WHILE NOT INSTAT
WEND
ans$=inkey$
SELECT CASE ans$
CASE chr$(0,72)
xqprint item$(subscript%),curntpos%-1+row%,col%,attr%
DECR curntpos%
DECR subscript%
IF subscript% < 1 THEN
ERASE item$
LOCATE 1,1,0
restorescreen pop$
GOTO 101
END IF
IF curntpos% < 1 THEN
ERASE item$
LOCATE 1,1,0
restorescreen pop$
GOTO 101
END IF
CASE chr$(0,80)
xqprint item$(subscript%),curntpos%-1+row%,col%,attr%
INCR curntpos%
INCR subscript%
IF subscript% > UBOUND(item$(1)) THEN
ERASE item$
LOCATE 1,1,0
restorescreen pop$
GOTO 101
END IF
IF curntpos% > UBOUND(item$(1)) THEN
ERASE item$
LOCATE 1,1,0
restorescreen pop$
GOTO 101
END IF
CASE CHR$(27)
ERASE item$
LOCATE 1,1,0
restorescreen s$
GOTO endloop
CASE chr$(13)
SELECT CASE curntpos%
CASE 1
zpayment_type$ = "1"
change% = 1
GOTO 101
CASE 2
zpayment_type$ = "2"
change% = 1
GOTO 101
CASE 3
zpayment_type$ = "3"
change% = 1
GOTO 101
CASE 4
zpayment_type$ = "4"
change% = 1
GOTO 101
CASE 5
zpayment_type$ = "5"
change% = 1
GOTO 101
CASE 6
zpayment_type$ = "6"
change% = 1
GOTO 101
CASE 7
zpayment_type$ = "7"
change% = 1
GOTO 101
CASE 8
zpayment_type$ = "8"
change% = 1
GOTO 101
CASE 9
GOTO 101
END SELECT
END SELECT
xqprint item$(subscript%),curntpos%+row%-1,col%,mhattr%
LOOP
101:
ERASE item$
SELECT CASE direction% ' ********* determine if your going up or down ***********
CASE 1
eptr% = 2
CASE 2
eptr% = 4
END SELECT
restorescreen pop$
LOCATE erow%,ecol%:
COLOR 7,1
SELECT CASE zpayment_type$
CASE "1"
PRINT "CASH"
CASE "2"
PRINT "CHRG"
CASE "3"
PRINT "CHEC"
CASE "4"
PRINT "M/CD"
CASE "5"
PRINT "VISA"
CASE "6"
PRINT "DISC"
CASE "7"
PRINT "AMEX"
CASE "8"
PRINT "R/OA"
END SELECT
'editoneline zpayment_type$,erow%,ecol%,lineLen%, editkey%, 7,0
restorescreen pop$
CASE 4
erow%= 12
editoneline zlabor_chrg$,erow%,ecol%,lineLen%, editkey%, 7,0
CASE 5
erow%= 13
editoneline zpart_chrg$,erow%,ecol%,lineLen%, editkey%, 7,0
CASE 6
erow%= 14
editoneline ztax_chrg$,erow%,ecol%,lineLen%, editkey%, 7,0
CASE 7
erow%= 15
editoneline zepa_chrg$,erow%,ecol%,lineLen%, editkey%, 7,0
CASE 8
erow%= 16
editoneline zroapaid$,erow%,ecol%,lineLen%, editkey%, 7,0
END SELECT
'*************** exit edit procedure ******************
IF eptr% = 100 THEN
restorescreen s$
REDIM larr$(counter%+1)
REDIM record_nums%(counter%)
ERASE item$, record_nums%,larr$
CLOSE
LOCATE 1,1,0
EXIT FAR
END IF
IF eptr% = 50 THEN
restorescreen s$
CLOSE #14
LOCATE 1,1,0
GOTO endloop
END IF
LOOP
CASE CHR$(0,62)
CLOSE
REDIM larr$(counter%+1)
ERASE larr$,record_nums%
MEMPACK
CHAIN "ar.pbc"
CASE CHR$(0,60)
s$ = savescreen$
xqprint SPACE$(79),25,1,fnattr%(7,1)
popwindow 6,15,19,65,1,fnattr%(14,1),0,-5,0,""
xqprint STRING$(51,196),7,15,fnattr%(7,1)
ctext 6,"ENTER SALES TRANSACTION",7,1
eptr% = 1
emaxitem% = 8
zclient_name$ = SPACE$(25)
zlabor_chrg$ = SPACE$(12)
zpart_chrg$ = SPACE$(12)
ztax_chrg$ = SPACE$(10)
zepa_chrg$ = SPACE$(10)
zrecord_date$ = DATE$
zpayment_type$ = SPACE$(12)
zdiscount$ = SPACE$(20)
xqprint "CLIENT : "+zclient_name$,9,15,fnattr%(7,1)
xqprint "DATE : "+zrecord_date$,10,15,fnattr%(7,1)
xqprint "PAID : "+zpayment_type$,11,15,fnattr%(7,1)
xqprint "LABOR : "+zlabor_chrg$,12,15,fnattr%(7,1)
xqprint "PARTS : "+zpart_chrg$,13,15,fnattr%(7,1)
xqprint "TAX : "+ztax_chrg$,14,15,fnattr%(7,1)
xqprint "EPA : "+zepa_chrg$,15,15,fnattr%(7,1)
xqprint "DISCOUNT : "+zdiscount$,16,15,fnattr%(7,1)
xqprint STRING$(51,196),18,15,fnattr%(7,1)
ctext 19,"F2=SAVE RECORD ESC=EXIT",7,1
ecol% = 26
direction% = 0
DO
SELECT CASE eptr%
CASE 1
erow%= 9
editentry zclient_name$,erow%,ecol%,lineLen%, editkey%, 7,0
CASE 2
erow%= 10
editentry zrecord_date$,erow%,ecol%,lineLen%, editkey%, 7,0
CASE 3
erow%= 11
'***************** display spelling of payment types ***********
pop$ = savescreen$
DIM item$(9)
item$(1) = " CASH "
item$(2) = " CHRG "
item$(3) = " CHEC "
item$(4) = " M/CD "
item$(5) = " VISA "
item$(6) = " DISC "
item$(7) = " AMEX "
item$(8) = " R/OA "
item$(9) = " EXIT "
subscript% = 1
curntpos% = 1
itemcount% = UBOUND(item$(1))
row% = 8
col% = 50
downto% = row%+itemcount%
outTo% = LEN(item$(1))+col%-1
bordr% = 1
attr% = fnattr%(14,4)
mhattr% = fnattr%(0,7)
PopWindow row%,col%,downto%-1,outTo%,bordr%, attr%, 0, -5, 10, ""
for mloop% = 1 to itemcount%
xqprint item$(mloop%),mloop%+row%-1,col%,attr%
next
xqprint item$(1),row%,col%,mhattr%
DO
WHILE NOT INSTAT
WEND
ans$=inkey$
SELECT CASE ans$
CASE chr$(0,72)
xqprint item$(subscript%),curntpos%-1+row%,col%,attr%
DECR curntpos%
DECR subscript%
IF subscript% < 1 THEN subscript% = UBOUND(item$(1))
IF curntpos% < 1 THEN curntpos% = UBOUND(item$(1))
CASE chr$(0,80)
xqprint item$(subscript%),curntpos%-1+row%,col%,attr%
INCR curntpos%
INCR subscript%
IF subscript% > UBOUND(item$(1)) THEN subscript% = 1
IF curntpos% > UBOUND(item$(1)) THEN curntpos% = 1
CASE CHR$(27)
ERASE item$
restorescreen s$
GOTO endloop
CASE chr$(13)
SELECT CASE curntpos%
CASE 1
zpayment_type$ = "1"
GOTO 102
CASE 2
zpayment_type$ = "2"
GOTO 102
CASE 3
zpayment_type$ = "3"
GOTO 102
CASE 4
zpayment_type$ = "4"
GOTO 102
CASE 5
zpayment_type$ = "5"
GOTO 102
CASE 6
zpayment_type$ = "6"
GOTO 102
CASE 7
zpayment_type$ = "7"
GOTO 102
CASE 8
zpayment_type$ = "8"
GOTO 102
CASE 9
GOTO 102
END SELECT
END SELECT
xqprint item$(subscript%),curntpos%+row%-1,col%,mhattr%
- Thread starter
- #5
From my experience i say learn Python as it is not hard and has many applications. Gives you good base for learning other languages as well. There is large python community to help you with difficult projects so it is fun really and firms like to see Python on your resume.
iamwhatiseem
Diamond Member
Coding is more of a way of life than a job. So to speak.
I use to do some coding back in the 90s. Wrote several programs for shortcutting and customization. (In other words, taking code that is all ready written and changing it to fit custom needs.)
It requires dogged determination and a stubbornness to make it happen. In many cases it requires herculean will to spend hours upon hours working on just one problem.
I use to do some coding back in the 90s. Wrote several programs for shortcutting and customization. (In other words, taking code that is all ready written and changing it to fit custom needs.)
It requires dogged determination and a stubbornness to make it happen. In many cases it requires herculean will to spend hours upon hours working on just one problem.
- Thread starter
- #8
good thing about python is the large community. if you are stuck in a project its easy to find help.
Similar threads
New Topics
-
Sec. State Marco Rubio Shutters ‘Disinformation’ Agency at State Department- Started by Doc7505
- Replies: 2
-
-
80 years ago today (4/30) one of the most murderous leftists in history committed suicide- Started by Z99
- Replies: 4
-
-
Sen. Adam Schiff (D-Calif.) assault weapons ban
- Started by TroglocratsRdumb
- Replies: 5
