A simple program that I wrote using Nantucket Clipper Summer '87 a very long time ago while I am working as a freelance database developer using DOS environment.
My email address are the following jakerpomperada@gmail.com and jakerpomperada@yahoo.com.
My mobile number here in the Philippines is 09173084360.
My email address are the following jakerpomperada@gmail.com and jakerpomperada@yahoo.com.
My mobile number here in the Philippines is 09173084360.
My telephone number at home here in Bacolod City, Negros Occidental is (034) 4335675.
Program Listing
********************************
** Payroll System
** Add Employees Record Routine
** Add.Prg
** Author : Jake R. Pomperada
** Language : Clipper Summer '87
** Date : March 07,2001
********************************
Set Talk Off
Set Echo Off
* Set Escape Off
Set Scoreboard Off
Set Procedure To Kes
Set Procedure To Sys
Set Procedure To Pass
Set Cursor On
Set Wrap On
Set Century On
Set Safety Off
Set Confirm Off
Set Delimiters On
Set Delimiters to "[]"
Set Cursor On
Set Decimal to 2
Set Message to 24
Clear Typeahead
Clear Memory
Clear Screen
@ 1,3 Clear To 23,79
@ 1,3 To 23,79 Double
Set Color To W/N
@ 2,12 Clear to 3,65
XTitle1 = Chr(5) + " ADD EMPLOYEES RECORD ROUTINE " + Chr(5)
Set Color To W+/N
@ 2,8 Say xTitle1
Set Color To
@ 3,4 Say Replicate("=",75)
Set Color To GR+/N
@ 2,62 Say "Date: " + Dtoc(Date())
Set Color To
@ 04,6 Clear To 22,77
Set color To Bg+/N
@ 4,52 Say "ESC -> Return To Main Menu"
Set Color To
Do While .T.
Use Pay
Index on ChapaNo to Xchapa
Reindex
Store 0 To XChapaNo
Store 0.00 To XSalaryRate
Store 0.00 To XTaxUnits
Store 0.00 To XST
Store 0.00 To XROT
Store 0.00 To XPOT
Store 0.00 To XEMERALLOW
Store 0.00 To ST2
Store 0.00 To ROT2
Store 0.00 To POT2
Store 0.00 To XWithTax
Store 0.00 To XPagibig
Store 0.00 To XPH
Store 0.00 To XSSS
Store 0.00 To XEMPLOYACC
Store 0.00 To XPhilH
Store 0.00 To XGross
Store 0.00 To XGrossTotal
Store 0.00 To XTotalNetPay
Store 0.00 To XTotalDeduc
Store 0.00 To XTotalDeduction
Store 0.00 To XYRTDGross
Store 0.00 To XYRTDWTax
Store Ctod(" / / ") To XDate
Store Space(25) to XLname
Store Space(20) to XFname
@ 04,8 Say "CHAPA NO.............þ " Get XChapaNo Pict "9999999999"
Read
If readkey() = 12
Return
*do kes
endif
XFind = XChapaNo
Seek XFind
if empty(XChapaNo)
Tone(200,2)
Tone(341,2)
Set Cursor Off
Set Color To N/W
@ 10,11 Clear To 12,53
@ 10,11 To 12,53
@ 11,16 say 'SORRY CHAPA NO. CANNOT BE EMPTY.'
Set Color To
Xdelay=inkey(2)
Set Cursor On
@ 10,11 Clear To 12,53
Loop
endif
If Found()
Tone(200,2)
Tone(341,2)
Set Cursor Off
Set Color To N/W
@ 13,14 Clear To 15,57
@ 13,14 To 15,57
@ 14,16 say 'SORRY DUPLICATE RECORDS IS NOT ALLLOWED.'
Set Color To
Xdelay=inkey(2)
Set Cursor On
@ 13,14 Clear To 15,57
Loop
endif
If .NOT. Found()
@ 05,8 Say "PAY ENDING...........þ " Get XDate Pict "99/99/9999"
@ 06,8 Say "LASTNAME.............þ " Get XLName Pict "@!"
@ 07,8 Say "FIRSTNAME............þ " Get XFName Pict "@!"
@ 08,8 Say "SALARY RATE..........þ " Get XSalaryRate Pict "99999999.99"
@ 09,8 Say "TAX UNITS............þ " Get XTaxUnits Pict "99999999"
SetColor("W+/N")
@ 10,25 Say "GROSS PAY"
Set Color To
@ 11,8 Say "STRAIGHT TIME........þ " Get XST Pict "9999999.99"
@ 12,8 Say "REGULAR O/T..........þ " Get XROT Pict "9999999.99"
@ 13,8 Say "PAID O/T.............þ " Get XPOT Pict "999999999.99"
@ 14,8 Say "PAID HOLIDAY.........þ " Get XPH Pict "999999999.99"
@ 15,8 Say "EMERGENCY ALLOWANCE..þ " Get XEMERALLOW Pict "999999999.99"
Read
If readkey() = 12
Return
*do kes
endif
ST2 = XSt * XSalaryRate / 8
ROT2 = XRot * XSalaryRate / 8 * 1.25
POT2 = XPot * XSalaryRate / 8 * 1.30
@ 16,8 Say "STRAIGHT TIME........þ " + ' '+Str(ST2,10,2)
@ 17,8 Say "REGULAR O/TIME.......þ " + ' '+Str(ROT2,10,2)
@ 18,8 Say "PAID O/TIME..........þ " + ' '+Str(POT2,10,2)
@ 19,8 Say "PAID HOLIDAY.........þ " + ' '+Str(XPH,10,2)
@ 20,8 Say "EMERGENCY ALLOWANCE..þ " + ' '+Str(XEMERALLOW,10,2)
XTOTALGross = ST2+ROT2+POT2+XPH+XEMERALLOW
Set Color TO W+/N
@ 22,8 Say "TOTAL GROSS..........þ " + ' '+Str(XTOTALGROSS,10,2)
Set Color To
XTotalNetPay = XTotalGross - XTotalDeduc
if xTotalNetPay <= 3000
xphilh = 37.50
endif
if xTotalNetPay >= 3500
xphilh = 43.75
endif
if xTotalNetPay >= 4000
xphilh = 50.00
endif
if xTotalNetPay >= 4500
xphilh = 56.25
endif
if xTotalNetPay >= 5000
xphilh = 62.50
endif
if xTotalNetPay >= 5500
xphilh = 68.75
endif
if xTotalNetPay >= 6000
xphilh = 75.00
endif
if xTotalNetPay >= 6500
xphilh = 81.25
endif
if xTotalNetPay >= 7000
xphilh = 87.50
endif
if xTotalNetPay >= 7500 .or. xTotalNetPay >= 30000
xphilh =93.75
endif
Set Color TO W+/N
@ 09,55 Say "DEDUCTIONS"
Set Color To
@ 10,47 Say "WHOLDING TAX.....þ" Get XWithTax Pict "9999999.99"
@ 11,47 Say "SSS PREMIUM......þ" Get XSSS Pict "9999999.99"
@ 12,47 Say "PAG-IBIG.........þ" Get XPAGIBIG Pict "9999999.99"
@ 13,47 Say "EMPLOYEE ACCT....þ" Get XEMPLOYACC Pict "9999999.99"
@ 14,47 Say "PHILHEALTH.......þ" + ' ' +Str(XPhilh,10,2)
* Get XPHILH Pict "9999999.99"
Read
Set Color To W+/N
XTotalDeduc = XWithTax+XSSS+XPAGIBIG+XEMPLOYACC+XPHILH
XTotalNetPay = XTotalGross - XTotalDeduc
@ 16,47 Say "TOTAL DEDUCTION..þ " + ' ' +Str(XTotalDeduc,10,2)
@ 17,47 Say "TOTAL NET PAY....þ " + ' ' +Str(XTotalNetPay,10,2)
Set Color To
@ 19,47 Say "YR.TO DATE GROSS.þ" Get XYRTDGROSS Pict "9999999.99"
@ 20,47 Say "YR.TO DATE W/TAX.þ" Get XYRTDWTAX Pict "9999999.99"
Read
If readkey() = 12
Return
*do kes
endif
endif
Mess1 = " SAVING EMPLOYEES RECORD IN DATABASE FILE."
Mess2 = " CHANGE OR UPDATE THE EMPLOYEES RECORD."
Mess3 = " ABORT OPERATION AND RETURN TO MAIN MENU."
Set Color To W+/n,W+*/W,W/N
@ 22,48 Prompt " SAVE " Message Mess1
@ 22,57 Prompt " EDIT " Message Mess2
@ 22,65 Prompt " CANCEL " Message Mess3
Menu To XChoice
Do Case
Case XChoice = 1
Tone(345,2)
Tone(145,2)
Case XChoice = 2
Tone(345,2)
Tone(145,2)
Case XChoice = 3
Tone(345,2)
Tone(145,2)
endcase
Set Color To
*sdelay=inkey(4)
* do kes
Return
enddo
No comments:
Post a Comment