home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / cpmug / cpmug045.ark / P_R130.BAS < prev    next >
Encoding:
BASIC Source File  |  1984-04-29  |  3.8 KB  |  112 lines
  1.     REMARK    *********************************************\
  2.         *  P/R130.BAS  PAYROLL DEDUCTION CALCULATE  *\
  3.         *   5/17/79                       9:55 AM   *\
  4.         *********************************************
  5.  
  6. %INCLUDE CURSOR
  7.  
  8.     DIM E$(2),G3(5),G2$(5),S(96),R$(5),R1(2),R2(5)
  9.  
  10.     GOTO 6000
  11.  
  12. 825    Z1=59                                REMARK  ****    LINE PRINTER ROUTINE    ****
  13.  
  14.     IF LINE.COUNT%<55  THEN RETURN                    REMARK  IF SPACE REMAINS ON REPORT PAGE, RETURN
  15.     P=P+1
  16.     PRINT CHR$(0CH);
  17.     PRINT TAB((Z1-LEN(G2$(1)))/2);G2$(1);TAB(Z1);"DATE ";        REMARK  PRINT COMPANY NAME AND REPORT DATE
  18.     X0=G3(1):GOSUB 680.5
  19.     PRINT
  20.     PRINT TAB((Z1-LEN(X4$))/2);X4$;TAB(Z1);"PAGE ";P        REMARK  PRINT REPORT TITLE AND PAGE NUMBER
  21.     PRINT
  22.     PRINT
  23.     PRINT "EMPLOYEE  TR  TC  FREQ  DESCRIPTION  ERROR DESCRIPTION"    REMARK  PRINT PAGE HEADINGS
  24.     PRINT
  25.     LINE.COUNT%=6                            REMARK  RESET LINE COUNTER FOR NEW REPORT PAGE
  26.     RETURN
  27.  
  28. %INCLUDE SUBS1
  29. %INCLUDE MSTRIN
  30. %INCLUDE MSTROUT
  31. %INCLUDE GENINFO
  32.  
  33. 4600    IF P=0 THEN LINE.COUNT%=60                    REMARK  PRINT DEDUCTION ERROR ON PRINTER
  34.     GOSUB 825                            
  35.     PRINT USING MASKA$;D1,D2,D3,D4,D1$,E$(A4)
  36.     LINE.COUNT%=LINE.COUNT%+1
  37.     RETURN
  38.  
  39.  
  40. 6000    DEF FNR(A1)=INT(A1*100+.5)/100                    REMARK  ROUNDING FUNCTION
  41.  
  42.     MASKA$="  ######   #   #   ##   /##########/  /##################/"
  43.  
  44.     PRINT CLEAR.SCREEN$;"P/R DEDUCTION CALCULATE"            REMARK  DISPLAY PROGRAM I.D. ON SCREEN
  45.     PRINT "ENTER START EMPLOYEE NUMBER OF ZERO TO EXIT"
  46.     PRINT 
  47.     PRINT 
  48.     PRINT "START EMPLOYEE NUMBER"
  49.     PRINT "END EMPLOYEE NUMBER"
  50.  
  51.     X1=279:X2=3:X3=0:X4=999:GOSUB 345                REMARK  ENTER START EMPLOYEE; IF ZERO, END PROGRAM
  52.     IF X0=0 THEN 7000
  53.     E1=X0
  54.  
  55. 6005    X1=343:X2=3:X3=E1:X4=999:GOSUB 345                REMARK  ENTER END EMPLOYEE NUMBER
  56.     E2=X0
  57.  
  58.     X2$="ENTRY CORRECT?":X2=1:X3=0:X4=1:GOSUB 665            REMARK  VERIFY ENTRY: '1'=O.K., '0'=RETRY
  59.     IF X0 <> 1 THEN 6000
  60.  
  61. 6100    Y3=3
  62.     OPEN "P/R0F030.DAT" RECL 38 AS 3                REMARK  OPEN DEDUCTION/MISCELLANEOUS PAY FILE
  63.     Y9=2
  64.     OPEN "P/R0F110.DAT" RECL 1150 AS 1                REMARK OPEN EMPLOYEE MASTER FILE
  65.     OPEN "G/I0F010.DAT" RECL 200 AS 2:GOSUB 700            REMARK OPEN AND READ GENERAL INFORMATION FILE
  66.     IF E2>MSTR.RECORDS THEN E2=MSTR.RECORDS
  67.     E$(1)="NO MASTER/RELEASED"
  68.     E$(2)="INSUFFICIENT FUNDS"
  69.     LPRINTER                            REMARK  SELECT PRINTER AS OUTPUT DEVICE
  70.  
  71. 6135    WHILE D1 <= E2                            REMARK  PROCESS RECORDS WHILE IN EMPLOYEE RANGE
  72.     INPUT.COUNT=INPUT.COUNT+1
  73.     READ #Y3,INPUT.COUNT;D1,D2,D3,D4,D1$,D5,D6            REMARK  READ DEDUCTION/MISCELLANEOUS PAY RECORD
  74.  
  75.     IF D1 > E2 \                            REMARK  IF ABOVE EMPLOYEE RANGE
  76.     OR D1 < E1 \
  77.     OR D4 > 9  \                            REMARK  OR DEDUCTION RECORD WAS USED
  78.     OR D2 = 1  \                            REMARK  OR RECORD IS MISCELLANEOUS PAY,
  79.     THEN GOTO 6230
  80.  
  81.  
  82.     IF D4=5 AND G3(4) <> 1 THEN GOTO 6230                REMARK  REJECT DEDUCTIONS SLATED FOR OTHER PERIODS
  83.     IF D4=6 AND G3(4) <> 2 THEN GOTO 6230
  84.  
  85.     IF D1 > MSTR.RECORDS THEN A4=1:GOSUB 4600:GOTO 6230
  86.     X0=D1:GOSUB 745                            REMARK  READ EMPLOYEE MASTER RECORD
  87.     IF S(1)=0 OR R2(1)=99 THEN A4=1:GOSUB 4600:GOTO 6230        REMARK  IF EMPLOYEE IS INACTIVE OR DELETED, PRINT ERROR
  88.  
  89. 6195    A2=D6
  90.     IF D5 > 0 THEN A2=FNR(D5*(S(83))/100):GOTO 6215            REMARK  CALCULATE DEDUCTION AMOUNT BASED ON RATE
  91. 6205    IF S(83)-S(90) < A2 THEN A4=2:A2=S(83)-S(90):GOSUB 4600        REMARK  IF DEDUCTION EXCEEEDS NET CHECK FOR EMPLOYEE,\
  92.                                             THEN PRINT ERROR OR PRINTER
  93. 6215    IF D2 <> 2 THEN A1=D2 ELSE A1=0
  94.  
  95. 6220    FOR I%=41 TO 89 STEP 24                        REMARK  ACCUMULATE DEDUCTION AMOUNT TO EMPLOYEE RECORD
  96.     S(I%-A1)=S(I%-A1)+A2
  97.     S(I%+1)=S(I%+1)+A2
  98.     NEXT I%
  99.  
  100.     D6=A2                                REMARK  SET DEDUCTION AMOUNT; FLAG RECORD AS USED
  101.     D4=D4+10
  102.  
  103.     PRINT #Y3,INPUT.COUNT;D1,D2,D3,D4,D1$,D5,D6            REMARK  RESAVE RECORD AS 'USED' ON DEDUCTION FILE
  104.  
  105.     X0=D1:GOSUB 750                            REMARK  RESAVE EMPLOYEE MASTER RECORD
  106. 6230    WEND
  107.  
  108. 7000    CONSOLE                                REMARK  TERMINATE PROGRAM AND LOAD MENU
  109.     PRINT CLEAR.SCREEN$;"P/R DEDUCTION CALCULATE LOADING MENU"
  110.     CHAIN "P/R000"
  111.  
  112.