home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / cpmug / cpmug043.ark / A_R050.BAS < prev    next >
Encoding:
BASIC Source File  |  1984-04-29  |  11.0 KB  |  364 lines
  1.     REMARK    ******************************************\
  2.         *  A/R050.BAS  CUSTOMER FILE MAINTENANCE *\
  3.         *      6/19/79             3:15  PM      *\
  4.         ******************************************
  5.  
  6.  
  7.     DIM M$(5),S$(2),Y(2),Z(2),G2$(5),G3(5)
  8.     YES=1
  9.     WRITTEN$=CHR$(255)
  10. %INCLUDE CURSOR
  11.     S$(1)="CUSTOMER ACTIVITY REPORT":S$(2)="LIST OF CUSTOMERS"
  12.     GOTO 6000
  13. %INCLUDE SUBS1
  14. %INCLUDE GENINFO
  15. %INCLUDE READCUST
  16. %INCLUDE WRITCUST
  17. %INCLUDE A/R-INFO
  18.  
  19.  
  20.  
  21. 825    IF LINE.COUNT% < 55 AND PAGE.COUNT% > 0 THEN RETURN        REMARK    LINE PRINTER ROUTINE
  22.     PAGE.COUNT%=PAGE.COUNT%+1
  23.     PRINT CHR$(12);
  24.     PRINT TAB((A1%-LEN(G2$(1)))/2);G2$(1);TAB(A1%);"DATE ";
  25.     X0=G3(1):GOSUB 680.5
  26.     PRINT 
  27.     PRINT TAB((A1%-LEN(X4$))/2);X4$;TAB(A1%);"PAGE";PAGE.COUNT%
  28.     PRINT
  29.     PRINT CHR$(10);" CODE";TAB(17);"NAME";
  30.     IF F1=1 THEN \
  31.     PRINT TAB(32);"LAST ACTIVITY   CURRENT YEAR     LAST YEAR"\
  32.     ELSE\
  33.     PRINT TAB(38);"ADDRESS";TAB(117);"PHONE NO."
  34.     PRINT
  35.     LINE.COUNT%=6
  36.     RETURN 
  37.  
  38.  
  39. 2000    REMARK    ********************************************\
  40.         * CUSTOMER FILE SEARCH ROUTINE  12/78  MAM *\
  41.         * ======================================== *\
  42.         *   THIS SUBROUTINE USES THE 'B' ALGORITHM *\
  43.         * FROM KNUTH'S SORTING AND SEARCHING BOOK. *\
  44.         *   THE ROUTINE FIRST SEARCHES A/R0F110.DAT*\
  45.         * AND, IF NO MATCH IS FOUND FOR THE KEY IN *\
  46.         * K$, THE ROUTINE THEN SEARCHES A/R0F111 IN*\
  47.         * ORDER TO EITHER FIND A NEWLY ADDED RECORD*\
  48.         * OR POSITION THE POINTER, L, TO THE LOCA- *\
  49.         * TION OF THE RECORD TO INSERT.            *\
  50.         ********************************************
  51.  
  52.     Y2=1:RECORD.COUNT=AR.CUSTFILE.EXTENT
  53. 2005    IF LEN(K$)<6 THEN K$=K$+" ":GOTO 2005
  54.     GOSUB 2060                            REMARK    PERFORM SEARCH ON A/R0F110.DAT
  55.     IF H <> -1 THEN RETURN
  56. 2010    Y2=2:RECORD.COUNT=NEW.CUSTOMER.RECORDS%
  57.     GOSUB 2060                            REMARK    IF A/R0F110 SEARCH FAILS, CHECK A/R0F111
  58.     RETURN
  59. 2060    H=0
  60.     IF RECORD.COUNT < 1 THEN H=-1:L=1:RETURN
  61.     READ #Y2,1;VAR$,VAR1
  62.     IF K$ < VAR$ THEN H=-1:L=1:RETURN
  63.     IF K$ = VAR$ THEN L=1:RETURN
  64.     READ #Y2,RECORD.COUNT;VAR$,VAR1
  65.     IF K$ > VAR$ THEN H=-1:L=RECORD.COUNT+1:RETURN
  66.     IF K$ = VAR$ THEN L=RECORD.COUNT:RETURN
  67.     H=RECORD.COUNT
  68.     L=0
  69. 2070    M=INT((L+H)/2)
  70.     READ #Y2,M;VAR$,VAR1
  71.     IF VAR$=K$ THEN L=M:RETURN
  72.     IF VAR$ > K$ THEN H=M
  73.     IF VAR$ < K$ THEN L=M
  74.     IF H=M+1 THEN H=-1:L=M+1:RETURN
  75.     GOTO 2070
  76.     RETURN 
  77.  
  78.  
  79. 5000    IF F=1 OR F=2 OR F=3 OR F=4 THEN\
  80.     X1=331+64*F:X2=24:X3=0:X4=0:GOSUB 345:\                 REMARK    ENTER CUSTOMER NAME/ADDR
  81.     M$(F+1)=X0$:RETURN
  82. 5020    IF F=5 THEN X1=658:GOSUB 673:D=X0:\                  REMARK    ENTER CUSTOMER'S LAST ACTIVITY DATE
  83.     RETURN
  84.     IF F=6 OR F=7 THEN\
  85.     X1=664+(F-5)*64:X2=11:X3=-9999999.99:X4=9999999.99:GOSUB 345:\
  86.     Y(F-5)=X0:\                              REMARK    ENTER CUSTOMER TOTAL FIELDS IN THIS ROUTINE
  87.     RETURN
  88.     X1=849:GOSUB 210
  89.     PRINT "    "
  90.     IF F=8 THEN\
  91.     X1=853:X2=10:X3=0:X4=9999999999:GOSUB 345:\              REMARK    ENTER PHONE NUMBER
  92.     P9=X0:\
  93.     X0=P9:X1=850:GOSUB 760:PRINT                    REMARK    DISPLAY PHONE NUMBER ON CRT
  94.     RETURN 
  95.  
  96. 5100    FOR I%=2 TO 5
  97.     X1=396+(I%-2)*64:GOSUB 210
  98.     PRINT M$(I%)
  99.     NEXT I%
  100.     X1=658:GOSUB 210
  101.     X0=D:GOSUB 680.5                        REMARK    DISPLAY ACTIVITY DATE
  102.     PRINT 
  103.     X1=22:GOSUB 215
  104.     PRINT USING MASKA$;Y(1)
  105.     X1=22:GOSUB 215
  106.     PRINT USING MASKA$;Y(2)
  107.     X0=P9:X1=850:GOSUB 760
  108.     RETURN 
  109.  
  110.  
  111.  
  112. 5200    REMARK    **********   CUSTOMER FILE PRINT ROUTINE   **********
  113.  
  114.     IF Y9=1 AND MSTR.RECORD$=WRITTEN$ THEN RETURN
  115.     IF Y9=2 AND  NEW.RECORD$=WRITTEN$ THEN RETURN
  116.     GOSUB 3225                            REMARK    GET CUSTOMER RECORD
  117.     X4$=S$(F1):A1%=76+31*SGN(F1-1)                    REMARK    SET REPORT TITLE & COLUMN WIDTH
  118.     GOSUB 825                            REMARK    CHECK FOR END OF FORM
  119.     LINE.COUNT%=LINE.COUNT%+1                    REMARK    PRINT CUSTOMER NUMBER AND NAME
  120.     PRINT W1$; TAB(9); M$(2);
  121.     IF F1=2 THEN\                            REMARK    IF CUSTOMER LIST, PRINT ADDR & PHONE
  122.     PRINT TAB(35); M$(3); TAB(61); M$(4); TAB(87); M$(5); TAB(113); :\
  123.     X0=P9:GOSUB 760.5:PRINT
  124.  
  125.     IF F1=1 THEN\                            REMARK    IF ACTIVITY REPORT,
  126.         PRINT TAB(34);:\                    REMARK    PRINT ACTIVITY DATE & SALES AMOUNTS
  127.     X0=D:GOSUB 680.5:\
  128.     PRINT TAB(48);: PRINT USING MASKA$; Y(2);: PRINT TAB(62);:\
  129.     PRINT USING MASKA$; Y(1):\
  130.     Z(2)=Z(2)+Y(2):\                        REMARK    ADD TO LAST-YEAR TOTALS
  131.     Z(1)=Z(1)+Y(1)                            REMARK    ADD TO THIS-YEAR TOTALS
  132.     RETURN
  133.  
  134.  
  135.                                     REMARK    START OF MAIN PROGRAM
  136. 6000    MASKA$=" #######.##"
  137.     MASKB$=" ##########.##"
  138.     OPEN "A/R0F110.DAT" RECL 162 AS 1, "A/R0F130.DAT" AS 3,\
  139.     "G/I0F010.DAT" AS 4, "CRT" RECL 1100 AS 19
  140.     CREATE "A/R0F111.DAT" RECL 162 AS 2
  141.     FILE.NO=3: GOSUB 3.14                        REMARK    RETRIEVE A/R FILE EXTENT INFORMATION
  142.     CLOSE 3
  143.     Y9=4:GOSUB 700                            REMARK    RETRIEVE G/I FILE DATA
  144.     CLOSE 4
  145.     CONSOLE
  146.     X0=18:GOSUB 260
  147. 6020    X2=1:X3=0:X4=4                            REMARK    PROMPT FOR OPERATION CODE
  148.     X2$="ENTER OPERATION CODE(0=EXIT;1=ADD;2=CHANGE;3=PRINT;4=YR END)"
  149.     GOSUB 665
  150.     C=X0+1
  151.     IF C=1 THEN GOTO 6290                        REMARK    IF 'EXIT' WAS SELECTED,BRANCH
  152.     IF C=3 THEN GOTO 6120                        REMARK    GO TO CHANGE RECORD ROUTINE
  153.     IF C=4 THEN GOTO 6260                        REMARK    BRANCH TO THE FILE PRINT ROUTINE
  154.     IF C=5 THEN GOTO 6280                        REMARK    GO TO YEAR-END ROUTINE
  155. 6040    GOSUB 265                            REMARK    REFRESH CRT MASK
  156.     X1=30:GOSUB 210
  157.     PRINT "ADD    "
  158.     X1=271:X2=6:X3=0:X4=0:GOSUB 345                        REMARK    ENTER CUSTOMER NO.
  159.     IF X0$<=" " THEN GOSUB 265:GOTO 6020                  REMARK    RE-PROMPT OPERATION CODE IF BLANK ENTRY
  160.     K$=X0$
  161.     GOSUB 2000                            REMARK    SEARCH A/R0F110 FOR CUSTOMER, THEN SEARCH A/R0F111
  162.                                     REMARK    IN CASE IT ENTERED ON THE DATA INPUT FILE.
  163.     IF H=-1 THEN GOTO 6100
  164.     IF VAR1 > 0 THEN X2$="ALREADY ON FILE":GOSUB 615:GOTO 6040\
  165.     ELSE\
  166.     RE.USE.DELETED.RECORD=YES:FILE.ASSIGNMENT=Y2
  167. 6100    W1$=K$
  168. 6100.1    IF LEN(W1$)<6 THEN W1$=W1$+" ":GOTO 6100.1
  169.     FOR I1%=1 TO 8
  170.     F=I1%
  171.     GOSUB 5000
  172.     NEXT I1%
  173.     GOTO 6160
  174.     
  175. 6110    IF RE.USE.DELETED.RECORD=YES THEN Y9=FILE.ASSIGNMENT:\
  176.     X0=L:GOSUB 3275:RE.USE.DELETED.RECORD=0:GOTO 6040
  177.  
  178.  
  179.     IF L > NEW.CUSTOMER.RECORDS% THEN GOTO 6115
  180.     FOR I=NEW.CUSTOMER.RECORDS% TO L STEP -1
  181.     READ #2,I;LINE X0$
  182.     PRINT USING "&";#2,I+1;X0$                    REMARK    WRITE CUSTFILE AT I+1
  183.     NEXT I
  184. 6115    NEW.CUSTOMER.RECORDS%=NEW.CUSTOMER.RECORDS%+1
  185.     Y9=2:X0=L:GOSUB 3275
  186.     CLOSE 2
  187.     OPEN "A/R0F111.DAT" RECL 162 AS 2
  188.     REMARK    THE FILE IS CLOSED & THEN RE-OPENED TO SAVE THE FCB IN \
  189.     A FILE DISASTER SITUATION.
  190.     GOTO 6040                            REMARK    START OVER FOR ANOTHER NEW CUSTOMER
  191. 6120    GOSUB 265                            REMARK    REFRESH CRT MASK
  192.     X1=30:GOSUB 210
  193.     PRINT "CHANGE "
  194. 6140    X1=271:X2=6:X3=0:X4=0:GOSUB 345                    REMARK    ENTER CUSTOMER #
  195.     IF X0$ <= " " THEN GOTO 6020                    REMARK    PROMPT OPERATION CODE IF BLANK ENTRY
  196.     K$=X0$
  197.     GOSUB 2000
  198.     IF H=-1 OR VAR1 = 0 THEN X2$="NOT ON FILE":GOSUB 615:GOTO 6120
  199.     X0=L:Y9=Y2:GOSUB 3225                        REMARK    GET CUSTOMER RECORD FROM FILE
  200.     GOSUB 5100
  201. 6160    X2=2:X3=0:X4=99
  202.     X2$="ENTER FIELD TO CHANGE (0=NONE, 99=DELETE)"
  203.     GOSUB 665
  204.     F=X0
  205.     IF F=0 AND C=2 THEN GOTO 6110
  206.     IF F=0 THEN GOTO 6180
  207.     IF F=99 THEN GOTO 6200
  208.     GOSUB 5000
  209.     GOTO 6160
  210. 6180    X0=L
  211.     GOSUB 3275
  212.     GOTO 6120
  213. 6200    X2=3:X3=0:X4=0:X2$="ENTER DELETE CODE":GOSUB 665
  214.     IF X0$="DEL" THEN D=0:\
  215.     X0=L:GOSUB 3275                        REMARK    RE-SAVE RECORD WITH A '0' LAST ACTIVITY DATE
  216.     X2$="RECORD DELETED":GOSUB 615
  217.     GOTO 6020
  218. 6220    X2$="NOT ON FILE":GOSUB 615
  219.     GOTO 6140
  220. 6260    X1=30:GOSUB 210
  221.     PRINT "PRINT  "
  222.     P=0
  223.     X2=1:X3=0:X4=2:X2$="ENTER REPORT TYPE (0=NONE, 1=ACTIVITY, 2=LIST) "
  224.     GOSUB 665
  225.     F1=X0
  226.     IF F1=0 THEN GOTO 6020
  227.     Z(1)=0
  228.     Z(2)=0
  229.     CLOSE 1
  230.     CLOSE 2
  231.     OPEN "A/R0F110.DAT" RECL 162 AS 1, "A/R0F111.DAT" RECL 162 AS 2
  232.     LPRINTER WIDTH 131
  233.     GOSUB 6800
  234.     GOSUB 6810
  235.     LINE.COUNT%=66
  236.     Y9=0
  237.     X0=0
  238. 6265    IF MSTR.READ% > AR.CUSTFILE.EXTENT AND NEW.READ% > NEW.CUSTOMER.RECORDS%\
  239.     THEN\
  240.     GOTO 6270
  241.  
  242.     IF NEW.RECORD$ > MSTR.RECORD$\
  243.     OR\
  244.     NEW.READ% > NEW.CUSTOMER.RECORDS%\
  245.     THEN\
  246.     X0=MSTR.READ%:Y9=1:GOSUB 5200:\
  247.     MSTR.RECORD$=WRITTEN$:\
  248.     GOSUB 6800
  249.  
  250.     IF NEW.RECORD$=WRITTEN$ THEN GOTO 6265
  251.  
  252.     IF MSTR.RECORD$ > NEW.RECORD$\
  253.     OR\
  254.     MSTR.READ% > AR.CUSTFILE.EXTENT\
  255.     THEN\
  256.     X0=NEW.READ%:Y9=2:GOSUB 5200:\
  257.     NEW.RECORD$=WRITTEN$:\
  258.     GOSUB 6810
  259.     GOTO 6265
  260. 6270    PRINT
  261.     NEW.READ%=0
  262.     MSTR.READ%=0
  263.     IF F1=1 THEN PRINT "TOTALS";TAB(45);:PRINT USING MASKB$;Z(2);Z(1)
  264.     PRINT
  265.     CONSOLE
  266.     GOTO 6260
  267. 6280    X1=30:GOSUB 210
  268.     PRINT "YR. END"
  269.     X2=1:X3=0:X4=1:X2$="DO YOU HAVE A RECENT ACTIVITY REPORT?"
  270.     GOSUB 665
  271.     IF X0=0 THEN 6260
  272.     X2=1:X3=0:X4=1:X2$="O.K. TO DO YEAR END UPDATE?"
  273.     GOSUB 665
  274.     IF X0 <> 1 THEN GOTO 6020
  275.     PRINT "WORKING - DO NOT INTERRUPT"
  276.     Y9=1
  277.     FOR I%=1 TO AR.CUSTFILE.EXTENT
  278.     X0=I%
  279.     GOSUB 3225
  280. 6281    Y(1)=Y(2):Y(2)=0                        REMARK    RESET TOTALS
  281.     GOSUB 3275
  282.     NEXT I%
  283.     Y9=2
  284.     IF NEW.CUSTOMER.RECORDS%=0 THEN 6285
  285.     FOR I%=1 TO NEW.CUSTOMER.RECORDS%
  286.     X0=I%
  287.     Y(1)=Y(2):Y(2)=0
  288.     GOSUB 3275
  289.     NEXT I%
  290. 6285    GOSUB 265
  291.     GOTO 6020
  292. 6290    REMARK    END OF MAINLINE CODE, START OF MERGE ROUTINE...
  293.     PRINT CURSOR.HOME$:PRINT:PRINT "WORKING... DO NOT INTERRUPT"
  294.     IF AR.CUSTFILE.EXTENT=0 THEN DELETE 1:\
  295.     CLOSE 2:A=RENAME("A/R0F110.DAT","A/R0F111.DAT"):\
  296.     OUTPUT.COUNT%=NEW.CUSTOMER.RECORDS%:GOTO 9000
  297.     CLOSE 1,2,19
  298.     OPEN "A/R0F110.DAT" RECL 162 AS 1, "A/R0F111.DAT" RECL 162 AS 2
  299.     CREATE "WORKFILE.DAT" RECL 162 AS 3
  300.     IF NEW.CUSTOMER.RECORDS% >0 THEN GOTO 6299
  301.     X2=1:X3=0:X4=0
  302.     X2$="ENTER 'Y' TO REORGANIZE CUSTOMER FILE; ANY OTHER KEY TO EXIT PROGRAM"
  303.     GOSUB 665
  304.     IF X0$ <> "Y" THEN GOTO 9005
  305. 6299    GOSUB 6800                            REMARK    GET THE FIRST MASTER RECORD
  306.     GOSUB 6810                             REMARK    GET THE FIRST "NEW" RECORD
  307. 6300    IF MSTR.READ% > AR.CUSTFILE.EXTENT \
  308.     AND NEW.READ% > NEW.CUSTOMER.RECORDS% THEN GOTO 8999
  309.     IF NEW.RECORD$ > MSTR.RECORD$\
  310.     OR\
  311.     NEW.READ% > NEW.CUSTOMER.RECORDS%\
  312.     THEN \                                    REMARK    IF MASTER RECORD IS LOWER, IT SATISFIES OUTPUT NEEDS
  313.     Y9=1:X0=MSTR.READ%:GOSUB 3225:\                    REMARK    GET THE RECORD
  314.     GOSUB 6900:\                            REMARK    WRITE THE MASTER CUSTOMER RECORD OUT TO WORKFILE.DAT
  315.     MSTR.RECORD$=WRITTEN$:\
  316.     GOSUB 6800                            REMARK    READ ANOTHER RECORD FROM A/R0F110.DAT
  317.  
  318.     IF NEW.RECORD$=WRITTEN$ THEN GOTO 6300
  319.  
  320.     IF MSTR.RECORD$ > NEW.RECORD$\
  321.     OR\
  322.     MSTR.READ% > AR.CUSTFILE.EXTENT\
  323.     THEN\
  324.     Y9=2:X0=NEW.READ%:GOSUB 3225:\                    REMARK    GET THE RECORD
  325.     GOSUB 6900:\
  326.     NEW.RECORD$=WRITTEN$:\
  327.     GOSUB 6810
  328.     GOTO 6300
  329.  
  330.  
  331. 6800    IF END #1 THEN 6801
  332.     MSTR.READ%=MSTR.READ%+1
  333.     READ #1, MSTR.READ%; MSTR.RECORD$, VAR1
  334.     IF VAR1 = 0 THEN GOTO 6800                    REMARK    IF LAST ACTIVITY=0 THEN READ NEXT RCD
  335.     RETURN
  336. 6801    MSTR.READ%=AR.CUSTFILE.EXTENT + 1
  337.     MSTR.RECORD$=WRITTEN$
  338.     RETURN
  339. 6810    REMARK READ RECORD FROM A/R0F111.DAT
  340.     IF END #2 THEN 6811
  341.     NEW.READ%=NEW.READ%+1
  342.     READ #2, NEW.READ%; NEW.RECORD$, VAR1
  343.     IF VAR1=0 THEN GOTO 6810                    REMARK    IF LAST ACTIVITY=0 THEN READ NEXT RCD 
  344.     RETURN
  345. 6811    NEW.READ%=NEW.CUSTOMER.RECORDS% + 1
  346.     NEW.RECORD$=WRITTEN$
  347.     RETURN
  348. 6900                                    REMARK    WRITE CUSTOMER RECORD TO WORKFILE
  349.     OUTPUT.COUNT%=OUTPUT.COUNT%+1
  350.     Y9=3
  351.     X0=OUTPUT.COUNT%
  352.     GOSUB 3275                            REMARK    WRITE CUSTOMER RECORD TO WORKFILE
  353.     RETURN
  354. 8999    DELETE 1                            REMARK    DELETE A/R0F110.DAT
  355.     DELETE 2                            REMARK    DELETE A/R0F111.DAT
  356.     CLOSE 3                                REMARK    CLOSE WORKFILE.DAT BEFORE RENAMING IT
  357.     A=RENAME("A/R0F110.DAT","WORKFILE.DAT")                REMARK    WORKFILE BECOMES NEW CUSTOMER FILE
  358. 9000    AR.CUSTFILE.EXTENT=OUTPUT.COUNT%
  359.     FILE.NO=5
  360.     OPEN "A/R0F130.DAT" AS FILE.NO
  361.     GOSUB 3.15                            REMARK    RE-WRITE NEW EXTENT INFO
  362. 9005    PRINT CLEAR.SCREEN$;"A/R CUSTOMER F/M LOADING MENU"
  363.     CHAIN "A/P000"                            REMARK    TERMINATE PROGRAM AND CHAIN TO MENU
  364.