home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / cpmug / cpmug045.ark / P_R250.BAS < prev    next >
Encoding:
BASIC Source File  |  1984-04-29  |  2.6 KB  |  65 lines
  1.     REMARK    *********************************\
  2.         *  P/R250.BAS  INSURANCE REPORT *\
  3.         *    5/17/79           1:25 PM  *\
  4.         *********************************
  5. %INCLUDE CURSOR
  6.     DIM G2$(5),G3(5)
  7.     DIM S(96),R$(5),R1(2),R2(5),A(2),E(2),C1(100),C2(100)
  8.     GOTO 6000
  9. %INCLUDE SUBS1
  10. %INCLUDE GENINFO
  11. %INCLUDE MSTRIN
  12. 825    A1=51                                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$(12);
  17. 830    PRINT TAB((A1-LEN(G2$(1)))/2);G2$(1);TAB(A1);"DATE ";        REMARK  PRINT COMPANY NAME AND DATE
  18.     X0=G3(1):GOSUB 680.5
  19.     PRINT
  20.     PRINT TAB((A1-LEN(X4$))/2);X4$;TAB(A1);"PAGE ";P        REMARK  PRINT REPORT TITLE AND PAGE NUMBER
  21.     PRINT
  22. 835    PRINT" CLASS  TOTAL EARNINGS   EXEMPT EARNINGS         NET"
  23.     PRINT
  24.     LINE.COUNT%=6                            REMARK  SET LINE COUNTER FOR NEW REPORT PAGE
  25.     RETURN 
  26. 6000    DEF FNR(Z1)=INT(Z1*100+.5)/100
  27.     MASKA$=" #####      #######.##        #######.##  #######.##"    REMARK  SET UP PRINT MASKS
  28.     MASKB$=" /12345/    #######.##        #######.##  #######.##"
  29.     PRINT CLEAR.SCREEN$;"P/R INSURANCE REPORT"
  30.     PRINT "KEY RETURN TO BEGIN; CTRL-C TO EXIT"
  31. 6000.1    IF CONSTAT%=0 THEN GOTO 6000.1 ELSE A%=CONCHAR%            REMARK  POLL KEYBOARD FOR <RETURN> OR CTRL-C
  32.     IF A%=03H THEN GOTO 6200                    REMARK  TERMINATE PROGRAM IF CTRL-C PRESSED
  33.     IF A% <> 0DH THEN GOTO 6000.1                    REMARK  WAIT FOR <RETURN> TO BE PRESSED
  34.     Y9=2:OPEN "G/I0F010.DAT" RECL 200 AS Y9
  35.     GOSUB 700                            REMARK  READ GENERAL INFORMATION FILE
  36.     LPRINTER                            REMARK  SELECT PRINTER AS OUTPUT DEVICE
  37.     OPEN "P/R0F110.DAT" RECL 1150 AS 1                REMARK  OPEN EMPLOYEE MASTER FILE
  38.     X4$="INSURANCE CLASS REPORT"
  39.     LINE.COUNT%=60
  40.     FOR J%=1 TO MSTR.RECORDS                    REMARK  USE THE ENTIRE MASTER FILE
  41.     X0=J%
  42.     GOSUB 745                            REMARK  READ EMPLOYEE RECORD
  43.     IF S(3)>99 THEN\                        REMARK  IF INSURANCE CLASS IS INVALID, ADD MONTHLY
  44.     E(1)=E(1)+S(7):\                                AMOUNTS TO ERROR TOTAL
  45.     E(2)=E(2)+S(10)\
  46.     ELSE\
  47.     I=S(3)+1:\                            REMARK  OTHERWISE, ADD TO INSURANCE CLASS TOTAL
  48.     C1(I)=C1(I)+S(7):\
  49.     C2(I)=C2(I)+S(10)
  50.     A(1)=A(1)+S(7)                            REMARK  ACCUMULATE TOTAL MONTHLY PAY
  51.     A(2)=A(2)+S(10)                            REMARK  ACCUMULATE INSURANCE-EXCLUDABLE TOTAL
  52.     NEXT J%
  53. 6055    FOR I%=1 TO 100
  54.     IF C1(I%)=0 THEN 6080
  55.     GOSUB 825
  56.     PRINT USING MASKA$;I%-1,C1(I%),C2(I%),C1(I%)-C2(I%)
  57.     LINE.COUNT%=LINE.COUNT%+1
  58. 6080    NEXT I%
  59.     IF E(1)=0 THEN 6095
  60.     PRINT USING MASKB$;"ERROR",E(1),E(2),E(1)-E(2)
  61. 6095    PRINT
  62.     PRINT USING MASKB$;"TOTAL",A(1),A(2),A(1)-A(2)
  63. 6200    CONSOLE
  64.     PRINT CLEAR.SCREEN$;"P/R INSURANCE REPORT LOADING MENU"        REMARK  EXIT PROGRAM AND LOAD MENU
  65.     CHAIN "P/R000"