home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / cpmug / cpmug045.ark / P_R110.BAS < prev    next >
Encoding:
BASIC Source File  |  1984-04-29  |  7.3 KB  |  258 lines
  1.     REMARK    *********************************************\
  2.         *  P/R110.BAS  DEDUCTION FILE MAINTENANCE   *\
  3.         *   5/16/79                      3:15 PM    *\
  4.         *********************************************
  5.  
  6.  
  7. %INCLUDE CURSOR
  8. %INCLUDE PRNMASK
  9.     DEF FNEXACT(X0,X1,X2)=X0*100+X1*10+X2                    REMARK  BINARY SEARCH KEY FUNCTION
  10.  
  11.     GOTO 6000
  12.  
  13. %INCLUDE SUBS1.BAS
  14.  
  15.  
  16. 1000    READ #Y3%,X0;D1,D2,D3,D4,D1$,D5,D6:RETURN            REMARK  READ DEDUCTION RECORD SUBROUTINE
  17.  
  18.  
  19.  
  20. 1010    PRINT #Y3%,X0;D1,D2,D3,D4,D1$,D5,D6:RETURN            REMARK  WRITE DEDUCTION RECORD SUBRUTINE
  21.  
  22.  
  23.  
  24.  
  25. 1060    H%=0                                REMARK  BINARY SEARCH ROUTINE FOR DEDUCTION FILE
  26.     IF RECORD.COUNT%<1 THEN L%=1:H%=-1:RETURN
  27.     READ #Y3%,1;VAR1,VAR2,VAR3                    REMARK  READ FIRST RECORD IN FILE
  28.     VAR1=FNEXACT(VAR1,VAR2,VAR3)
  29.     IF K1 < VAR1 THEN H%=-1:L%=1:RETURN                REMARK  IF KEY IS LOW, RECORD DOES NOT EXIST
  30.  
  31.     IF K1=VAR1 THEN L%=1:RETURN                    REMARK  RETURN IF A MATCH WAS FOUND ON FIRST RECORD
  32.     READ #Y3%,RECORD.COUNT%;VAR1,VAR2,VAR3                REMARK  READ LAST RECORD IN FILE
  33.     VAR1=FNEXACT(VAR1,VAR2,VAR3)
  34.     IF K1 > VAR1 THEN H%=-1:L%=RECORD.COUNT%+1:RETURN        REMARK  IF KEY IS HIGH, RECORD DOES NOT EXIST
  35.     IF K1=VAR1 THEN L%=RECORD.COUNT%:RETURN
  36.  
  37.  
  38.     H%=RECORD.COUNT%                        REMARK  SET SEARCH POINTERS
  39.     L%=0
  40. 1070    M%=(L%+H%)/2                            REMARK  DIVIDE DATA SEARCH INTERVAL IN HALF
  41.  
  42.     READ #Y3%,M%;VAR1,VAR2,VAR3
  43.     VAR1=FNEXACT(VAR1,VAR2,VAR3)
  44.     IF VAR1=K1 THEN L%=M%:RETURN                    REMARK  IF RECORD WAS FOUND, RETURN
  45.     IF VAR1>K1 THEN H%=M%
  46.     IF VAR1<K1 THEN L%=M%
  47.     IF H%=M%+1 THEN H%=-1:L%=M%+1:RETURN                REMARK  IF SEARCH EXHAUSTED, SET FLAG AND RETURN
  48.     GOTO 1070
  49.  
  50.  
  51.  
  52. 5300    X1=466:X2=2:X3=0:X4=16:GOSUB 345                REMARK  CHANGE DEDUCTION FREQUENCY CODE
  53.     IF X0<=6 OR X0>=10 THEN D4=X0:RETURN\
  54.     ELSE\
  55.     X2$="OUT OF RANGE":GOSUB 615:GOTO 5300                REMARK  FLASH ERROR MESSAGE IF FREQUENCY ENTERED WAS INVALID
  56.  
  57.  
  58. 5350    X1=522:X2=10:X3=0:X4=0:GOSUB 345                REMARK  CHANGE DEDUCTION DESCRIPTION
  59.     D1$=X0$
  60.     RETURN
  61.  
  62.  
  63. 5400    IF D2 > 1\                            REMARK  ENTER/CHANGE RATE ON DEDUCTION RECORDS
  64.     THEN\
  65.     X1=591:X2=5:X3=0:X4=99.99:GOSUB 345\                REMARK  ENTER RATE FOR DEDUCTION-TYPE RECORDS ONLY
  66.     ELSE\
  67.     X2$="INVALID":GOSUB 615:RETURN                    REMARK  PROHIBIT RATE ENTRY ON MISCELLANEOUS INCOME
  68.     D5=X0
  69.     D6=0                                REMARK  IF RATE WAS ENTERED, ZERO OUT DEDUCTION AMOUNT
  70. 5410    X1=576:GOSUB 210
  71.     GOSUB 7045
  72.     RETURN
  73.  
  74.  
  75. 5450    X1=653:X2=7:X3=0:X4=9999.99:GOSUB 345                REMARK  CHANGE DEDUCTION OR MISC. INCOME AMOUNT
  76.     D6=X0
  77.     D5=0                                REMARK  IF AMOUNT WAS ENTERED, ZERO OUT RATE
  78.     GOTO 5410
  79.  
  80.  
  81.  
  82. 6000    MASK2$="##"
  83.     Y3%=1
  84.     OPEN "CRT" RECL 1100 AS 19                    REMARK  OPEN CRT MASK FILE
  85.     RECORD.COUNT%=0
  86.  
  87.     OPEN "P/R0F030.DAT" RECL 38 AS Y3%
  88.     IF END #Y3% THEN 6013                        REMARK  SET EOF BRANCH DESTINATION
  89. 6010    READ #Y3%;DUMMY                            REMARK  LOCATE END OF DEDUCTION FILE
  90.  
  91.     IF DUMMY =9000000000 THEN 6013
  92.     RECORD.COUNT%=RECORD.COUNT% + 1
  93.     GOTO 6010
  94. 6013    IF RECORD.COUNT%=0 THEN D1=9000000000:X0=1:GOSUB 1010
  95.     X0=7:GOSUB 260                            REMARK  DISPLAY CRT MASK FOR FILE MAINTENANCE
  96. 6014    X2$="ENTER OPERATION(0=EXIT;1=ADD;2=INQUIRE, CHANGE OR DELETE)"
  97.     X2=1:X3=0:X4=2:GOSUB 665                    REMARK  REQUEST OPERATON CODE 
  98.  
  99.  
  100.  
  101.     IF X0=0\                            REMARK  LOAD MENU IF ZERO OPERATION CODE WAS ENTERED
  102.     THEN\
  103.     PRINT CLEAR.SCREEN$;"P/R DEDUCTION F/M LOADING MENU":\
  104.     CHAIN "P/R000"
  105.  
  106.  
  107.  
  108.  
  109.     IF X0=1 THEN 6200                        REMARK  BRANCH TO NEW RECORD ROUTINE IF CODE = 1
  110.  
  111.  
  112.  
  113. 6015    X1=273:X2=3:X3=0:X4=999:GOSUB 345                REMARK  ENTER EMPLOYEE NUMBER FOR DEDUCTION RECORD
  114.  
  115.     IF X0=0 THEN GOSUB 265:GOTO 6014                REMARK  IF EMPLOYEE NUMBER =0, PROMPT FOR OPERATION
  116.  
  117.     D1=X0
  118.     K1=FNEXACT(X0,0,0)                        REMARK  USE BINARY SEARCH TO FIND DEDUCTION RECORD
  119.     GOSUB 1060
  120.     READ #Y3%,L%;VAR1                        REMARK  READ DEDUCTION RECORD LOCATED BY SEARCH
  121.     IF VAR1 <> D1 THEN \
  122.     X2$="NOT ON FILE":GOSUB 615:GOTO 6015                REMARK  IF RECORD NOT FOUND, FLASH ERROR MESSAGE
  123.     REC%=L%
  124.     X0=REC%
  125.     GOSUB 1000                            REMARK  READ DEDUCTION RECORD FROM DISK
  126.  
  127. 6045    X1=256
  128.     GOSUB 7020                            REMARK  DISPLAY RECORD ON CRT
  129.  
  130.  
  131.  
  132. 6055    X2$="ENTER FIELD TO CHANGE (0=NONE; 99=DELETE)"
  133.     X2=2:X3=0:X4=99
  134.     GOSUB 665                            REMARK  ENTER FIELD TO CHANGE; 0=NONE, 99=DELETE
  135.  
  136.     IF X0>4 AND X0<99 THEN 6055                     REMARK  IF FIELD ENTERED IS INVALID, RE-PROMPT OPERATOR
  137.  
  138.     IF X0=0 THEN GOTO 6075
  139.     IF X0=99 THEN GOTO 6080
  140.  
  141.     ON X0 GOSUB 5300,5350,5400,5450:GOTO 6055            REMARK  IF A FIELD WAS SELECTED, CHANGE IT 
  142.  
  143.  
  144. 6075    X0=REC%:GOSUB 1010                        REMARK  SAVE DEDUCTION RECORD
  145.     D1.0=D1
  146.     REC%=REC%+1:X0=REC%:GOSUB 1000                    REMARK  READ SEQUENTIALLY FOR NEXT DEDUCTION RECORD
  147.  
  148.     IF D1 > D1.0 THEN GOTO 6015 ELSE GOTO 6045            REMARK  IF NO FURTHER RECORD FOR EMPLOYEE, PROMPT\
  149.                                             FOR NEW EMPLOYEE; ELSE, DISPLAY NEXT RECORD
  150.  
  151.  
  152. 6080    X2$="ENTER DELETE CODE"
  153.     X2=3:X3=0:X4=0
  154.     GOSUB 665                            REMARK  ENTER 3-CHARACTER DELETE CODE
  155.  
  156.     IF X0$<>"DEL" THEN 6055                        REMARK  IF INVALID CODE ENTERED, ABORT OPERATION
  157.  
  158.  
  159.     FOR I%= REC% TO RECORD.COUNT%                     REMARK  WRITE OVER DELETED RECORD
  160.     READ #Y3%,I%+1;LINE DATA$
  161.     PRINT USING "&";#Y3%,I%;DATA$
  162.     NEXT I%
  163.  
  164.  
  165.     RECORD.COUNT%=RECORD.COUNT%-1                    REMARK  DECREMENT ACTIVE RECORD COUNT
  166.  
  167.     X2$="RECORD DELETED":GOSUB 615                    REMARK  FLASH RECORD DELETION MESSAGE
  168.     GOTO 6015
  169.  
  170.  
  171.  
  172. 6200    GOSUB 265
  173.     D1=0:D2=0:D3=0:D4=0:D5=0:D6=0                    REMARK  ENTER NEW DEDUCTION RECORD
  174.     D1$=""
  175.     X1=273:X2=3:X3=0:X4=999:GOSUB 345                REMARK  ENTER EMPLOYEE NUMBER
  176.  
  177.     IF X0=0 THEN GOSUB 265:GOTO 6014                REMARK  IF EMPLOYEE NUMBER=0, PROMPT FOR OPERATION
  178.  
  179.  
  180.     D1=X0
  181. 6210    X1=339:X2=1:X3=1:X4=4:GOSUB 345                    REMARK  ENTER RECORD TYPE
  182.     D2=X0
  183.  
  184.  
  185.  
  186.     X1=403:X2=1:X3=0:X4=9:GOSUB 345                    REMARK  ENTER TAX/DEDUCTION PRIORITY CODE
  187.     D3=X0
  188.  
  189.  
  190.     GOSUB 5300                            REMARK  ENTER FREQUENCY CODE
  191.     GOSUB 5350                            REMARK  ENTER DESCRIPTION
  192.  
  193.  
  194.     IF D2 > 1 THEN GOSUB 5400                    REMARK  ENTER RATE IF THIS IS A DEDUCTION-TYPE RECORD
  195.     IF D5=0 THEN GOSUB 5450                        REMARK  IF RATE WAS NOT ENTERED, ENTER AMOUNT
  196.  
  197.  
  198.  
  199.  
  200. 6235    X2$="ENTER FIELD TO CHANGE (0=NONE; 99=CANCEL)"            REMARK  PROMPT FOR FIELD TO CHANGE
  201.     X2=2:X3=0:X4=99:GOSUB 665
  202.  
  203.     IF X0=99 THEN X2$="CANCELLED":GOSUB 615:GOTO 6200        REMARK  IF CANCEL CODE WAS ENTERED, RESTART OPERATION
  204.     IF X0=0 THEN GOTO 6255
  205.  
  206.     ON X0 GOSUB 5300,5350,5400,5450
  207.     GOTO 6235
  208.  
  209. 6255    K1=FNEXACT(D1,D2,D3)
  210.     GOSUB 1060                            REMARK  SEARCH FILE FOR INSERTION POINT
  211.  
  212.     FOR I%=RECORD.COUNT%+1 TO L% STEP -1
  213.     READ #Y3%,I%;LINE DATA$                        REMARK  MOVE FILE DOWN TO ALLOW FOR NEW RECORD INSERTION
  214.     PRINT USING "&";#Y3%,I%+1;DATA$
  215.     NEXT I%
  216.  
  217.  
  218. 6258    RECORD.COUNT% = RECORD.COUNT% + 1                    REMARK  INCREMENT ACTIVE RECORD COUNT
  219.     X0=L%
  220.     GOSUB 1010                            REMARK  WRITE THE NEW RECORD AT POSITION L
  221.  
  222.     CLOSE 1
  223.     OPEN "P/R0F030.DAT" RECL 38 AS 1                REMARK  SAVE ALTERED FCB IN CASE OF A FILE CRASH
  224.  
  225.     GOTO 6200                            REMARK  GO BACK FOR ANOTHER NEW RECORD
  226.  
  227.  
  228.  
  229. 7020    X1=270                                REMARK  DISPLAY DEDUCTION RECORD ON CRT
  230.     GOSUB 210
  231.     PRINT USING MASK6$;D1                        REMARK  DISPLAY EMPLOYEE NUMBER
  232.  
  233.  
  234.     X1=19:GOSUB 215
  235.     PRINT D2                            REMARK  DISPLAY RECORD TYPE
  236.  
  237.  
  238.     X1=19:GOSUB 215
  239.     PRINT D3                            REMARK  DISPLAY TAX CODE/DEDUCTION PRIORITY
  240.  
  241.  
  242.     X1=19:GOSUB 215
  243.     PRINT USING MASK2$;D4                        REMARK  DISPLAY FREQUENCY CODE
  244.  
  245.  
  246.     X1=11:GOSUB 215
  247.     PRINT "           "
  248.     X1=522:GOSUB 210:PRINT D1$                    REMARK  DISPLAY DEDUCTION DESCRIPTION
  249.  
  250.  
  251. 7045    X1=16:GOSUB 215
  252.     PRINT USING MASK2.2$;D5                        REMARK  DISPLAY RATE
  253.  
  254.  
  255.     X1=14:GOSUB 215
  256.     PRINT USING MASK4.2$;D6                        REMARK  DISPLAY AMOUNT
  257.     RETURN
  258.