home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload
/
ShartewareOverload.cdr
/
database
/
pay1per.zip
/
WAGES.PRG
< prev
next >
Wrap
Text File
|
1987-01-15
|
5KB
|
160 lines
*** Procedure Wages (V 2.6)01/15/87
*** Copyright @ 1987, Martin J. Michaelson
clear
set talk off
set bell off
RESTORE FROM PAY_TAX
SELECT 1
USE PAY_PERS INDEX EMPNO
SELECT 3
USE PAY_YTD INDEX EMPNMytd
STORE SPACE(1) TO QTR
@ 1,15 SAY "WELCOME TO WEEKLY PAYROLL PROCESSING"
@ 3,15 SAY "CURRENT PAYROLL QUARTER ?" GET QTR
READ
SELECT 2
USE PAY_WEK&QTR INDEX WEEKLY&QTR,EMPNM&QTR
STORE SPACE(8) TO WEEKEND
STORE SPACE(3) TO EMP_NMBR
STORE SPACE(8) TO GROSS
STORE SPACE(6) TO SSFCIA
store space(4) to disny
hrot = 0.0
hreg = 0.0
STORE .F. TO PAYR
DO WHILE .T.
CLEAR
@ 1,20 SAY "PAYROLL PROCESSING"
@ 3,20 SAY "WAGE PAYMENT SYSTEM"
@ 4, 8 SAY "WEEK ENDING : " GET WEEKEND PICTURE '99/99/99'
READ
IF WEEKEND = ' '
EXIT
ENDIF
DO NAMES
ACCEPT 'ENTER EMPLOYEE NAME: ' TO T_NAME
IF len(T_NAME) = 0
LOOP
ENDIF
SELECT 1
LOCATE FOR NAME = UPPER(T_NAME)
IF EOF() .OR. BOF()
@ 8, 6 SAY '<<< NO SUCH EMPLOYEE >>>'
LOOP
ENDIF
CLEAR
@ 3,20 SAY "PROCESSING INDIVIDUAL PAYROLL"
@ 6, 1 SAY NAME
@ 6,30 SAY 'EMP.No:'+ STR(EMP_NMBR,3)
@ 6,44 SAY 'PAY/HOUR:'+ STR(PAY_RATE,6,2)
@ 6,65 SAY 'DEDUCTS:'+ DED
@ 7, 1 say ' HOW MANY HRS(REG) DID '+TRIM(NAME)+' WORK?'
@ 7,54 get HREG PICT '99.9' range 1,40
@ 9, 1 say ' HOW MANY HRS(OVT) DID '+TRIM(NAME)+' WORK?'
@ 9,54 get HROT PICT '99.9' range 0,15
read
STORE ((HREG*A->PAY_RATE)+(HROT*A->PAY_RATE*1.5)) TO GROSS
SELECT 3
LOCATE FOR EMP_NMBR = A->EMP_NMBR
IF (GRO_YTD + GROSS) <FCGRO
STORE (GROSS * FICA) TO SSFCIA
ELSE
STORE ((FCGRO - GRO_YTD) * FICA) TO SSFCIA
IF SSFCIA < 0
STORE 0 TO SSFCIA
ENDIF
ENDIF
SELECT 2
APPEND BLANK
REPLACE EMP_NMBR WITH A->EMP_NMBR, WEEK_END WITH WEEKEND
REPLACE HRS_REG WITH HREG, HRS_OVT WITH HROT
REPLACE GRO_PAY WITH GROSS
REPLACE FCIA WITH SSFCIA
store (gross * disab) to DISNY
if DISNY > dismax
store dismax to DISNY
endif
REPLACE DIS with DISNY
@ 11, 1 say '$ '+STR(GROSS,8,2)+' GROSS PAY, $ '+STR(SSFCIA,6,2)+'ì
FCIA'
@ 12, 5 say "Federal Tax"
@ 13, 5 say "NYState Tax"
@ 14, 5 say "City Tax"
@ 15, 5 say "NYS Disab Tax"
@ 16, 5 say "Other Deducts"
@ 12,25 GET FWT PICTURE '9999.99'
@ 13,26 GET SWT PICTURE '999.99'
@ 14,26 GET CWT PICTURE '999.99'
@ 15,28 get DIS PICTURE '9.99'
@ 16,25 GET OTHER PICTURE '9999.99'
READ
*
REPLACE TOT_DED WITH (FCIA+FWT+SWT+CWT+DIS+OTHER)
REPLACE NET_PAY WITH (GRO_PAY-FCIA-FWT-SWT-CWT-DIS-OTHER)
SELECT 3
REPLACE GRO_YTD WITH (GRO_YTD + B->GRO_PAY)
REPLACE FCIA_YTD WITH (FCIA_YTD + B->FCIA)
REPLACE FWT_YTD WITH (FWT_YTD + B->FWT)
REPLACE SWT_YTD WITH (SWT_YTD + B->SWT)
REPLACE CWT_YTD WITH (CWT_YTD + B->CWT)
REPLACE DIS_YTD WITH (DIS_YTD + B->DIS)
REPLACE OTH_YTD WITH (OTH_YTD + B->OTHER)
REPLACE NET_YTD WITH (NET_YTD + B->NET_PAY)
SELECT 4
USE QTR&QTR INDEX QTREMP&QTR
LOCATE FOR EMP_NMBR = A->EMP_NMBR
REPLACE GRO_PAY WITH (GRO_PAY + B->GRO_PAY)
REPLACE FCIA WITH (FCIA + B->FCIA)
REPLACE FWT WITH (FWT + B->FWT)
REPLACE SWT WITH (SWT + B->SWT)
REPLACE CWT WITH (CWT + B->CWT)
REPLACE DIS WITH (DIS + B->DIS)
REPLACE TOT_DED WITH (TOT_DED + B->TOT_DED)
REPLACE NET_PAY WITH (NET_PAY + B->NET_PAY)
?
SET PRINT ON
?
? STR(EMP_NMBR,3)+' '+A->NAME+' '+WEEKEND
?
? 'HOURS '+STR(B->HRS_REG,4,1)+' Regular '+'ì
'+STR(B->HRS_OVT,4,1)+' Overtime'
? ' $'+STR(HREG*A->PAY_RATE,7,2)+' $ 'ì
+STR(HROT*1.5*A->PAY_RATE,7,2)+' GROSS PAYì
$'+STR(B->GRO_PAY,8,2)
?
?
? 'Fed Tax, FCIA, NYS Tax, CtyTax, Disab, OTHER, Totì
Ded, NET PAY'
? '$ '+STR(B->FWT,7,2)+' '+STR(B->FCIA,6,2)+'ì
'+STR(B->SWT,6,2)+' '+STR(B->CWT,6,2)+' '+STR(B->DIS,5,2)+'ì
'+STR(B->OTHER,7,2)+' '+STR(B->TOT_DED,7,2)+'ì
'+STR(B->NET_PAY,8,2)
?
?
?
?
SELECT 3
REPO FORM EMPYTD FOR EMP_NMBR = A->EMP_NMBR PLAIN NOEJECT
SET PRINT OFF
WAIT ' DO YOU WANT TO CONTINUE [Y or N] ?' TO X
IF .NOT. X $ 'Yy'
CLEAR
@ 6, 15 SAY " WEEKLY WAGE PAYMENT SYSTEM"
@ 8, 23 say " COMPLETE"
select 2
sum gro_pay,fcia,fwt,swt,cwt,dis,net_pay;
for week_end = weekend to mgro,mfcia,mf,ms,mc,mdis,mnet
select 5
use weektots
append blank
replace week with weekend, growage with mgro, fctot with mfcia,;
fwtot with mf,swtot with ms,cwtot with mc,distot with mdis,;
netwage with mnet
? mgro,mfcia,mf,ms,mc,mdis,mnet
EXIT
ELSE
LOOP
ENDIF
ENDDO WHILE PAYR
RETURN