Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : DPROGS.ZIP
Filename : PAYEMPS.PRG
* Does normal payroll processing or exceptions.
******************************************************************
*
Salaries = .T.
DO WHILE Salaries
CLEAR
@ 2,12 SAY '* * * * P A Y R O L L F U N C T I O N S * * * * '
@ 4,12 SAY '* 1> Normal Payroll * '
@ 6,12 SAY '* 2> Partial Payment * '
@ 8,12 SAY '* 3> Employee Leave * '
@ 10,12 SAY '* * * * * * * * * * * * * * * * * * * * * * * * * * * '
@ 12,12 SAY 'Choose a number or press
@ 14, 0
WAIT ' ' TO Payment
*
DO CASE
CASE Payment = '1'
@ ROW(),0 SAY 'Preparing Payroll'
DO Payroll
CASE Payment = '2'
@ ROW(),0 SAY 'Preparing Partial Payment'
CLEAR
SELECT 5
? 'This procedure allows you to pay less than a full salary if'
? 'for some reason an employee skipped days of work that are '
WAIT 'not to be paid for. Do you want to continue (Y or N)? ' TO T_Continue
?
DO WHILE UPPER(T_Continue) = 'Y'
ACCEPT 'Enter employees name.(Press
IF LEN(T_Name) <> 0
LOCATE FOR NAME = UPPER(T_Name)
IF .NOT. EOF()
@ 11,0
@ 9,56
@ 5,78
@ ROW()+2,0 SAY Name
? 'How many days did '+TRIM(NAME)+' work this pay period?'+SPACE(20)
INPUT 'There are 11 work days in a pay period.(1 hour = 0.1333) ';
TO T_Worked
?
IF TYPE('T_Worked') = 'U'
@ ROW()+1,0 SAY 'No change'
ELSE
REPLACE Ratio WITH T_Worked/11.0000
@ ROW()+1,0 SAY STR(Ratio*100,8,4)+'%'
RELEASE T_Worked
ENDIF
ELSE
@ ROW()+2,0 SAY T_Name + ' not found'+SPACE(20)
ENDIF
@ 5,45
@ 4,0
ELSE
@ 12,0
T_Continue = 'N'
ENDIF
ENDDO
*
CASE Payment = '3'
@ ROW(),0 SAY 'Preparing Emloyee Leave'
CLEAR
SELECT 5
? 'This procedure allows you to skip a paycheck in the payroll'
WAIT 'procedure. Do you want to continue (Y or N)? ' TO T_Continue
?
DO WHILE UPPER(T_Continue) = 'Y'
ACCEPT 'Enter employees name.(Press
IF LEN(T_Name) <> 0
LOCATE FOR NAME = UPPER(T_Name)
IF .NOT. EOF()
@ ROW()+2,0 SAY TRIM(Name)+;
' has been removed from the payroll'+SPACE(20)
REPLACE Paid WITH .T.
ELSE
@ ROW()+2,0 SAY T_Name + ' not found'+SPACE(35)
ENDIF
@ 4,45
@ 3,0
ELSE
T_Continue = 'N'
ENDIF
ENDDO
*
CASE LEN(Payment) = 0
RETURN
*
ENDCASE
RELEASE ALL LIKE T_*
ENDDO Salaries
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/