home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / cpmug / cpmug045.ark / P_R090.BAS < prev    next >
Encoding:
BASIC Source File  |  1984-04-29  |  7.8 KB  |  268 lines
  1.     REMARK    ************************************\
  2.         *  P/R090.BAS  PAYROLL ACCUMULATE  *\
  3.         *   5/16/79               1:30 PM  *\
  4.         ************************************
  5.  
  6. %INCLUDE CURSOR
  7.  
  8.     DIM S(96),R1(2),T2(8),R$(5),G2$(5),G3(5),B1(5),E$(3),R2(5)
  9.  
  10.     DEF FNR(Z)=INT(Z*100+.5)/100                    REMARK  ROUNDING FUNCTION
  11.  
  12.     GOTO 6000
  13. %INCLUDE SUBS1
  14. %INCLUDE GENINFO
  15. %INCLUDE MSTRIN
  16. %INCLUDE MSTROUT
  17.  
  18.  
  19. 825    A1=39                                REMARK  ****    LINE PRINTER ROUTINE    ****
  20.  
  21.     IF LINE.COUNT% <55 THEN RETURN                    REMARK  IF SPACE REMAINS ON REPORT PAGE, RETURN
  22.     PRINT CHR$(0CH);
  23.     P=P+1
  24.     PRINT TAB((A1-LEN(G2$(1)))/2);G2$(1);TAB(A1);"DATE ";        REMARK  PRINT COMPANY NAME AND REPORT DATE
  25.     X0=G3(1):GOSUB 680.5
  26.     PRINT 
  27.     PRINT TAB((A1-LEN(X4$))/2);X4$;TAB(A1);"PAGE";P            REMARK  PRINT REPORT TITLE, PAGE NUMBER AND HEADINGS
  28.     PRINT " EMPLOYEE  PAY TYPE  ERROR DESCRIPTION"
  29.     PRINT
  30.     LINE.COUNT%=5                            REMARK  RESET LINE COUNTER FOR NEW REPORT PAGE
  31.     RETURN 
  32.  
  33.  
  34.  
  35. 843    REMARK    *************  READ DEDUCTION RECORD ************
  36.     IF D4 > 9 THEN GOSUB 850
  37.     X0.0=X0.0+1
  38.     READ #Y3,X0.0;D1,D2,D3,D4,D1$,D5,D6
  39.     RETURN
  40. 850    REMARK    ************ WRITE DEDUCTION RECORD ************
  41.     PRINT #Y3,X0.0;D1,D2,D3,D4,D1$,D5,D6
  42.     RETURN
  43. 873    REMARK    ********** SAVE TRANSACTION SUMMARY RECORD *********
  44.  
  45.     IF B1(1) >= E1 AND B1(1) <= E2 AND B1(3) < 9 THEN B1(3)=B1(3)+10
  46.     PRINT #Y5,X0.1;B1(1),B1(2),B1(3),B1(4),B1(5)
  47.     RETURN
  48.  
  49. 875    REMARK  ********** READ TRANSACTION SUMMARY RECORD *********
  50.  
  51.     IF B1(1)>0 THEN GOSUB 873
  52.     X0.1=X0.1+1
  53.     READ #Y5,X0.1;B1(1),B1(2),B1(3),B1(4),B1(5)
  54.     RETURN
  55.  
  56. 876    B1(1)=9000000000:RETURN
  57.  
  58. 4003    IF S(1) > 0 AND S(1) = Z THEN RETURN                REMARK  IF EMPLOYEE NUMBER HAS NOT CHANGED, RETURN
  59.     IF S(1) > 0 THEN GOSUB 4600                    REMARK  SAVE CALCULATED EMPLOYEE RECORD
  60.  
  61.     X0=Z:GOSUB 745                            REMARK  GET NEXT EMPLOYEE MASTER RECORD
  62.  
  63.  
  64.     IF Z <> S(1) THEN\
  65.     Z0=1:GOSUB 4050:\                        REMARK  IF EMPLOYEE RECORD NOT FOUND, PRINT ERROR DATA
  66.     S(1)=0:RETURN
  67.  
  68.     IF S(4)=0 THEN RETURN                        REMARK  IF THIS EMPLOYEE'S SALARY HAS ALREADY BEEN\
  69.                                             ACCUMULATED (CHECK DATE=0), SKIP PROCESSING
  70.  
  71. 4045    IF R2(1) <> 99 THEN\                        REMARK  INITIALIZE CURRENT EMPLOYEE FIELDS 
  72.     S(4)=0:\
  73.     S(5)=0:\                                    BEFORE ACCUMULATING PAYROLL FOR EMPLOYEE
  74.     FOR I%=73 TO 90:\
  75.     S(I%)=0:\
  76.     NEXT I%:\
  77.     RETURN
  78.  
  79.  
  80. 4050    LPRINTER                            REMARK  PRINT ERROR DETAIL ON LINE PRINTER
  81.  
  82.     X4$="TRANSACTION ERROR REPORT"
  83.     GOSUB 825                            REMARK  PRINT REPORT HEADINGS-CHECK FOR END OF PAGE
  84.  
  85.     PRINT USING MASKA$;Z,Z1,E$(Z0)                    REMARK  PRINT EMPLOYEE NUMBER, PAY TYPE AND ERROR
  86.  
  87.     LINE.COUNT%=LINE.COUNT%+1
  88.     CONSOLE                                REMARK  SELECT CRT AS OUTPUT DEVICE
  89.     RETURN
  90.  
  91.  
  92. 4600    IF R2(1) <> 1 THEN S(76)=FNR(S(75)*S(8)/80*G3.0)        REMARK  PAY SALARIED EMPLOYEE OVERTIME BY ESTIMATING\
  93.                                             HOURLY RATE (BASED ON AN 80-HOUR PAYROLL PERIOD)
  94.  
  95.  
  96.     IF R2(1)  = 1 THEN S(74)=FNR(S(73)*S(8)):\            REMARK  CALCULATE REGULAR PAY FOR HOURLY EMPLOYEE
  97.                S(76)=FNR(S(75)*S(8)*G3.0)            REMARK  CALCULATE OVERTIME  ""     "" ""  ""  ""
  98.  
  99.     X0=S(1)
  100.     GOSUB 750                            REMARK  RESAVE EMPLOYEE RECORD ON DISK
  101.     RETURN
  102.  
  103.  
  104. 5300    GOSUB 843                            REMARK  READ NEXT DEDUCTION RECORD 
  105.  
  106.     IF D1 > E2 THEN D1=9000000000:RETURN                REMARK  IF PAST EMPLOYEE RANGE, REJECT RECORD
  107.  
  108.     IF D1 < E1\                            REMARK  IF RECORD IS BELOW ACCUMULATE RANGE
  109.     OR\
  110.     D2 <> 1\                                    OR RECORD IS NOT MISCELLANEOUS PAY
  111.     OR\
  112.     D4 > 9\                                        OR RECORD HAS BEEN USED
  113.     OR\
  114.     D4 = 3\                                        OR FREQUENCY CODE INDICATES 'NOT THIS TIME',
  115.     OR\
  116.     D4 = 4\
  117.     THEN GOTO 5300                            REMARK  THEN READ NEXT DEDUCTION/MISC. PAY RECORD
  118.  
  119.     IF D4=5 AND G3(4) <> 1 THEN GOTO 5300                REMARK  SKIP THIS RECORD IF FREQUENCY AND \
  120.                                             PAYROLL NUMBER ARE INCOMPATIBLE
  121.  
  122.     D4=D4+10:RETURN                            REMARK  IF MARK RECORD 'USED' AND USE IT
  123.  
  124.  
  125. 5350    GOSUB 875                            REMARK  READ THE NEXT PAYROLL SUMMARY RECORD
  126.  
  127.     IF B1(1) < E1 OR B1(3) > 9 THEN GOTO 5350            REMARK  IF RECORD IS USED OR BELOW RANGE, REJECT IT\
  128.                                             AND GET THE NEXT SUMMARY RECORD
  129.  
  130.     IF B1(1) > E2 THEN B1(1)=9000000000                REMARK  IF BEYOND RANGE, SET FLAG AND RETURN
  131.     RETURN 
  132.  
  133.  
  134.  
  135. 5400    S(82)=S(82)+D6                            REMARK  ADD MISCELLANEOUS INCOME AMOUNT TO OTHER PAY
  136.     IF D3 = 0 THEN S(84)=S(84)+D6                    REMARK  ADD TO NON-TAXABLE PAY IF APPLICABLE
  137.  
  138.     GOSUB 5300                            REMARK  READ NEXT MISCELLANEOUS PAY RECORD
  139.     RETURN 
  140.  
  141.  
  142. 5600    IF B1(3) = 6 THEN GOSUB 5350:RETURN                REMARK  IGNORE COMP-TIME TRANSACTIONS
  143.     ON B1(3)+1\
  144.     GOSUB 5610,\                            REMARK  IF PAY TYPE=0, PAY EMPLOYEE FLAT SALARY
  145.           5620,\                            REMARK  "  " "  " " 1, ADD TO EMPLOYEE REGULAR HOURS
  146.           5660,\                                    "  " "  " " 2, CALCULATE VACATION PAY
  147.           5720,\                                    "  " "  " " 3, ACCUMULATE HOLIDAY HOURS 
  148.           5700,\                                    "  " "  " " 4, CALCULATE PIECEWORK PAY
  149.           5720                             REMARK "  " "  " " 5, ACCUMULATE OVERTIME HOURS
  150.  
  151.  
  152.     GOSUB 5350                            REMARK  GET THE NEXT SUMMARY RECORD
  153.     RETURN 
  154.  
  155.  
  156. 5610    IF R2(1) <> 1 THEN S(74)=S(8):RETURN
  157.     IF S(1) > 0 THEN Z=S(1):Z0=2:Z1=B1(3):GOSUB 4050        REMARK  PRINT INVALID PAY TYPE ERROR MESSAGE\
  158.                                             IF EMPLOYEE TYPE IS INCOMPATIBLE
  159.     RETURN
  160.  
  161.  
  162.  
  163. 5620    S(73)=S(73)+B1(4)                        REMARK  ACCUMULATE REGULAR HOURS
  164.     RETURN 
  165.  
  166.  
  167. 5660    IF R2(1)=1 THEN S(81)=S(81)+B1(5):RETURN            REMARK  IF HOURLY EMPLOYEE, ADD UP VACATION PAY
  168.  
  169.     IF S(1)=0 THEN RETURN
  170.     S(14)=S(14)-B1(4)                        REMARK  SUBTRACT VACATION HOURS FROM REMAINING
  171.  
  172.     IF S(14) < 0 THEN \
  173.     Z=S(1):Z0=3:Z1=B1(3):GOSUB 4050:\                REMARK  IF INSUFFICIENT VACATION HOURS, PRINT ERROR
  174.     S(14)=0
  175.  
  176. 5680    S(80)=S(80)+B1(4)                        REMARK  ADD TO CURRENT VACATION HOURS TAKEN
  177.     RETURN 
  178.  
  179.  
  180. 5700    S(77)=S(77)+B1(4)                        REMARK  ACCUMULATE PIECEWORK HOURS AND PAY
  181.     S(78)=S(78)+B1(5)
  182.     RETURN 
  183.  
  184.  
  185. 5720    S(75)=S(75)+B1(4)                        REMARK  ACCUMULATE OVERTIME/HOLIDAY HOURS
  186.     RETURN 
  187.  
  188.  
  189.  
  190. 6000    Y3=3:Y9=10
  191.     Y5=4
  192.     LINE.COUNT%=60
  193.     MASKA$="   ######     ##     /##################/"
  194.     OPEN "P/R0F110.DAT" RECL 1150 AS 1                REMARK  OPEN EMPLOYEE MASTER FILE
  195. 6005    PRINT CLEAR.SCREEN$;"P/R ACCUMULATE"                REMARK  DISPLAY PROGRAM I.D. AND ENTRY MASK ON CRT
  196.     PRINT "ENTER START EMPLOYEE OF ZERO TO EXIT"
  197.     PRINT 
  198.     PRINT 
  199.     PRINT "START EMPLOYEE NUMBER"
  200.     PRINT "END EMPLOYEE NUMBER"
  201.  
  202.  
  203.     X1=279:X2=3:X3=0:X4=999:GOSUB 345                REMARK  ENTER START EMPLOYEE NUMBER
  204.  
  205.     IF X0=0\                            REMARK  IF START EMPLOYEE NUMBER IS ZERO, ABORT
  206.     THEN\
  207.     X2$="PROGRAM ABORTED":GOSUB 615:\
  208.     GOTO 6700
  209.  
  210.     E1=X0
  211.  
  212.     X1=343:X2=3:X3=E1:X4=999:GOSUB 345                REMARK ENTER END EMPLOYEE
  213.     E2=X0
  214.  
  215.     X2=1:X3=0:X4=1:X2$="ENTRY CORRECT?":GOSUB 665            REMARK  VERIFY ENTRY: '1'=O.K.; '0'=RETRY
  216.     IF X0 <> 1 THEN GOTO 6005
  217.  
  218.     OPEN "P/R0F030.DAT" RECL 38 AS Y3                REMARK  OPEN DEDUCTION/MISCELLANEOUS PAY FILE
  219.  
  220.     OPEN "P/R0F050.DAT" RECL 30 AS Y5                REMARK  OPEN PAYROLL SUMMARY FILE
  221.     IF END #Y5 THEN 876
  222.     OPEN "G/I0F010.DAT" RECL 200 AS Y9                REMARK  OPEN AND READ GENERAL INFORMATION FILE
  223.     GOSUB 700
  224.  
  225.     IF E2 > MSTR.RECORDS THEN E2 = MSTR.RECORDS
  226.  
  227. 6105    E$(1)="NOT FOUND/RELEASED"                    REMARK  SET ACCUMULATE ERROR DESCRIPTIONS
  228.     E$(2)="INVALID PAY TYPE"
  229.     E$(3)="INSUFFICIENT HOURS"
  230.  
  231.     GOSUB 5300                            REMARK  GET FIRST DEDUCTION AND PAYROLL SUMMARY RECORDS
  232.     GOSUB 5350
  233.  
  234.  
  235. 6200    IF D1 < B1(1) THEN\                        REMARK  PROCESS MISCELLANEOUS INCOME RECORD
  236.     Z=D1:\                                        IF IT IS LOWER THAN SUMMARY RECORD
  237.     Z1=D2:\
  238.     GOSUB 4003:\
  239.     GOSUB 5400:\
  240.     GOTO 6200
  241.  
  242.  
  243.     IF B1(1) < D1 THEN\                        REMARK  IF SUMMARY RECORD IS LOWER, PROCESS IT
  244.     Z=B1(1):\
  245.     Z1=B1(3):\
  246.     GOSUB 4003:\
  247.     GOSUB 5600:\
  248.     GOTO 6200
  249.  
  250.  
  251.  
  252.     IF D1=9000000000 THEN 6600                    REMARK  TERMINATE PROCESSING IF END OF BOTH FILES
  253.  
  254.  
  255.     Z=B1(1)                                REMARK  IF DEDUCTION RECORD EQUALS SUMMARY RECORD,\
  256.                                             PROCESS BOTH
  257.     Z1=B1(3)
  258.     GOSUB 4003
  259.     GOSUB 5400
  260.     GOSUB 5600
  261.     GOTO 6200
  262.  
  263. 6600    IF S(1) <> 0 THEN GOSUB 4600                    REMARK  SAVE LAST ACCUMULATED EMPLOYEE RECORD
  264.  
  265.  
  266. 6700    PRINT CLEAR.SCREEN$;"P/R ACCUMULATE LOADING MENU"        REMARK  END PROGRAM HERE
  267.     CHAIN "P/R000"
  268.