home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / SIMTEL / CPMUG / CPMUG045.ARK / P_R310.BAS < prev    next >
BASIC Source File  |  1984-04-29  |  5KB  |  128 lines

  1.     REMARK    *****************************************\
  2.         *  P/R310.BAS   OVERHEAD DISTRIBUTION   *\
  3.         *    3/23/79                  4:30 PM   *\
  4.         *****************************************
  5.  
  6. %INCLUDE CURSOR
  7.  
  8.     DIM W(2),W1(2),W2(14),W2$(2),G2$(5),G3(5)
  9.     DEF FNR(A1)=INT(A1*100+.5)/100                    REMARK  ROUNDING FUNCTION
  10.     GOTO 6000
  11.  
  12. %INCLUDE SUBS1
  13. %INCLUDE GENINFO
  14.  
  15. 6000    MASKA$="######.##"                        REMARK  SET UP PRINT MASKS
  16.     MASKB$="##.##"
  17.     MASKC$="######.## (##.##%)"
  18.     MASKD$="###.##"
  19.      Y8=1 
  20.     Y9=2
  21.     OPEN "JOB0F100.DAT" RECL 160 AS 1,"G/I0F010.DAT" RECL 200 AS 2,\REMARK  OPEN JOB, GENERAL INFOMATION AND CRT MASK FILES
  22.     "CRT" RECL 1100 AS 19
  23.     GOSUB 700                            REMARK  READ GENERAL INFORMATION FILE
  24.     X0=13:GOSUB 260                            REMARK  GET CRT MASK 13
  25. 6020    X1=64:GOSUB 210
  26.     PRINT "WORKING..."
  27.     IF JOB.RECORDS=0 THEN X2$="FILE IS EMPTY":GOSUB 615:\
  28.     GOTO 6225
  29. 6035    FOR K%=1 TO JOB.RECORDS
  30.     READ #1,K%;W(1),W(2)                        REMARK  READ JOB FILE
  31.     IF W(2)=0 THEN\
  32.     READ #1,K%;W(1),W(2),W1$,W1(1),W1(2),W2$(1),W2$(2):GOTO 6065    REMARK  IF HEADER RECORD ENCOUNTERED, READ IT IN
  33.     READ #1,K%;W(1),W(2),W2(1),W2(2),W2(3),W2(4),W2(5),\        REMARK  READ DETAIL RECORD IF W(2) IS POSITIVE
  34.     W2(6),W2(7),W2(8),W2(9),W2(10),W2(11),W2(12),W2(13),W2(14)
  35.     IF W2(3)=-1 THEN 6065                        REMARK  IF DETAIL RECORD WAS DELETED, SKIP IT
  36.  
  37.     J2=J2+W2(3)                            REMARK  ADD MONTHLY COST-2 FOR ALL JOBS INTO J2
  38.  
  39.      IF W2$(2)<>"1" THEN J=J+W2(3)                    REMARK  ADD COST-2 FOR ALL NON-PAYROLL OVERHEAD JOBS
  40.  
  41.      IF W2$(2)="0" THEN J0=J0+W2(3)                    REMARK  ADD COST-2 FOR ALL PAYROLL OVERHEAD JOBS
  42. 6065    NEXT K%
  43.  
  44.  
  45.     X1=270:GOSUB 210:PRINT USING MASKA$; J2;            REMARK  DISPLAY TOTAL OVERHEAD
  46.     X1=8:GOSUB 215:PRINT USING MASKA$; J2-J;            REMARK  SUBTRACT NON-PAYROLL OVERHEAD
  47.     X1=5:GOSUB 215:PRINT USING MASKA$; J;                REMARK  DISPLAY TOTAL PAYROLL COSTS FOR PERIOD
  48.  
  49.     X1=408:X2=5:X3=0:X4=99.99:GOSUB 345                REMARK  ENTER TAXES AND INSURANCE PERCENTAGE OF PAYROLL
  50.     R1=X0
  51.     X1=472:X2=5:X3=0:X4=99.99:GOSUB 345                REMARK  ENTER VACATION AND HOLIDAY PAY PERCENTAGE
  52.     R2=X0 
  53.     R3=R1+R2                            REMARK  ADD AND DISPLAY TOTAL PERCENTAGE
  54.  
  55.     X1=536:GOSUB 210
  56.     PRINT USING MASKB$; R3;
  57.     X1=8:GOSUB 215
  58.     PRINT USING MASKA$; FNR(R3/100*J);
  59.  
  60.  
  61.     X1=665:X2=9:X3=0:X4=999999.99:GOSUB 345                REMARK  ENTER GENERAL OFFICE OVERHEAD AMOUNT
  62.     O1=X0
  63.      IF O1>0 THEN R4=O1/J*100 ELSE R4=0                REMARK  CONVERT AMOUNT TO PERCENT OF TOTAL PAYROLL
  64.     X1=680:GOSUB 210:PRINT USING MASKB$; FNR(R4)            REMARK  PRINT PERCENTAGE
  65.     PRINT
  66.     X1=26:GOSUB 215:PRINT USING MASKA$; J0                REMARK  DISPLAY PERSONNEL OVERHEAD PAY
  67.  
  68.     X1=26:GOSUB 215:PRINT USING MASKC$; FNR(J0*R3/100); FNR(R3)    REMARK  DISPLAY PAYROLL OVERHEAD
  69.  
  70.     X1=26:GOSUB 215:PRINT USING MASKC$; FNR(J0*R4/100); FNR(R4)    REMARK  DISPLAY GENERAL OFFICE OVERHEAD
  71.  
  72.     J1=J0+FNR(J0*R3/100)+FNR(J0*R4/100)                REMARK  CALCULATE AND DISPLAY TOTAL PERSONNEL OVERHEAD
  73.     X1=26:GOSUB 215:PRINT USING MASKA$; J1;
  74.  
  75.      IF J1>0 THEN R5=J1/(J-J0)*100 ELSE R5=0                REMARK  CALCULATE AND DISPLAY PERSONNEL OHD PERCENT
  76.     X1=6:GOSUB 215:PRINT USING MASKD$; FNR(R5);
  77.     X1=11:GOSUB 215:PRINT USING MASKD$; FNR(R5)+FNR(R4)+FNR(R3)    REMARK  DISPLAY TOTAL OVERHEAD PERCENT
  78.  
  79.  
  80.     PRINT CURSOR.HOME$
  81.     PRINT
  82.     PRINT "KEY RETURN TO BEGIN; CTRL-C TO EXIT"
  83. 6160    IF CONSTAT%=0 THEN GOTO 6160                    REMARK  AWAIT OPERATOR CUE BEFORE STARTING PROCESSING
  84.     A%=CONCHAR%
  85.     IF A%=03H\
  86.     THEN\
  87.     X2$="PROGRAM ABORTED":GOSUB 615:\                REMARK  FLASH TERMINATION MESSAGE IF CTRL-C HIT
  88.     GOTO 9000
  89.     IF A% <>0DH THEN GOTO 6160                    REMARK  EXECUTE PROGRAM ONLY IF <RETURN> WAS HIT
  90.  
  91.  
  92.     PRINT "WORKING...DO NOT INTERRUPT";
  93.     FOR K%=1 TO JOB.RECORDS
  94.     READ #1,K%;W(1),W(2)
  95.     IF W(2)=0 THEN \
  96.     READ #1,K%;W(1),W(2),W1$,W2(1),W2(2),W2$(1),W2$(2):GOTO 6225    REMARK  READ HEADER RECORD
  97.  
  98.     READ #1,K%;W(1),W(2),W2(1),W2(2),W2(3),W2(4),W2(5),\        REMARK  IF W(2) IS POSITIVE, READ JIB DETAIL RECORD
  99.     W2(6),W2(7),W2(8),W2(9),W2(10),W2(11),W2(12),W2(13),W2(14)
  100.  
  101.     IF W2(3)=-1 OR W2$(2)="1" THEN 6225                REMARK  IF JOB RECORD WAS DELETED OR IS NOT TO HAVE\
  102.                                             OVERHEAD DISTRIBUTED TO IT, GET NEXT RECORD
  103.  
  104.     W2(4)=0:W2(5)=0:W2(6)=0:W2(7)=0                    REMARK  INITIALIZE ALL MONTHLY OVERHEAD AMOUNTS                
  105.      W2(4)=FNR(R3/100*W2(3))                        REMARK  CALCULATE PAYROLL OVERHEAD BASED ON COST-2
  106.      W2(5)=FNR(R4/100*W2(3))
  107.      IF W2$(2)<>"0"\
  108.     THEN\
  109.     W2(6)=FNR(R5/100*W2(3)):W2(14)=W2(14)+W2(7)            REMARK  ADD PERSONNEL AND MISCELLANEOUS OVERHEAD\
  110.                                             FOR ANY USER-DEFINED COST CENTER
  111.  
  112.      W2(7)=0
  113.      W2(11)=W2(11)+W2(4)                         REMARK  ADD ALL MONTHLY OVERHEAD TO J-T-D OVERHEAD
  114.     W2(12)=W2(12)+W2(5) 
  115.     W2(13)=W2(13)+W2(6)
  116.  
  117.  
  118. 6220    PRINT #1,K%;W(1),W(2),W2(1),W2(2),W2(3),W2(4),W2(5),\        REMARK  RE-WRITE DETAIL RECORD WITH DITRIBUTED COSTS
  119.     W2(6),W2(7),W2(8),W2(9),W2(10),W2(11),W2(12),W2(13),W2(14)
  120.  
  121. 6225    NEXT K%
  122.  
  123.  
  124.  
  125. 9000    PRINT CLEAR.SCREEN$;                        REMARK  END OF PROGARM -- CLOSE FILES, CHAIN MENU
  126.     PRINT"OVERHEAD DISTRIBUTION EXITING"
  127.     CHAIN "P/R000"
  128.