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