home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol163 / nadmenu.bas < prev    next >
Encoding:
BASIC Source File  |  1984-04-29  |  7.0 KB  |  212 lines
  1.         REM NADMENU.BAS   * PROGRAM MENU FOR NAME & ADDRESS      *
  2.         REM               * 2350
  3.         REM 05 29 83      * J.BUTLER
  4.         REM SYSTEM CONTROL PROGRAM NUMBER    :100
  5. %CHAIN 300,20000,2650,1200
  6.  
  7.         REM COMMONS GO HERE
  8.         COMMON CLEAR$,NAME$,LINE$,DEMO$,CRSR$,EOL$,DATE$,ID$,SCRPARA,EOS$
  9.         COMMON ROWOFF,COLOFF,DIO
  10.  
  11.         REM DIMENSIONS GO HERE
  12.         DIM MONTHS$(12),S(25)
  13.         DIO=0DB00H:REV$="052983"
  14.         FOR X=1 TO 25:READ S(X):POKE DIO-1+X,S(X):NEXT X
  15.         MONTHS$(1)="JANUARY":MONTHS$(2)="FEBRUARY":MONTHS$(3)="MARCH"
  16.         MONTHS$(4)="APRIL":MONTHS$(5)="MAY":MONTHS$(6)="JUNE"
  17.         MONTHS$(7)="JULY":MONTHS$(8)="AUGUST":MONTHS$(9)="SEPTEMBER"
  18.         MONTHS$(10)="OCTOBER":MONTHS$(11)="NOVEMBER":MONTHS$(12)="DECEMBER"
  19.         BLANK$="........................................................":ERR=1
  20.  
  21.         IF END #1 THEN 9992
  22.         OPEN "SCREEN.FIL" RECL 18 AS 1
  23.         IF END #2 THEN 9992
  24.         OPEN "COMPANY.DA" RECL 160 AS 2
  25.  
  26. 1       REM OPEN ANY MORE FILES HERE
  27.         REM  ** GET SCREEN PARAMETERS FROM SCREEN.FIL **
  28.         READ #1,1;A$,B$,C$
  29.         CLEAR$=CHR$(VAL(A$))+CHR$(VAL(B$))
  30.         READ #1,2;A$,B$,C$
  31.         CRSR$=CHR$(VAL(A$))+CHR$(VAL(B$))
  32.         READ #1,3;A$,B$,C$
  33.         EOS$=CHR$(VAL(A$))+CHR$(VAL(B$))
  34.         READ #1,4;A$,B$,C$
  35.         EOL$=CHR$(VAL(A$))+CHR$(VAL(B$))
  36.         READ #1,5;A$,B$,C$
  37.         CLRFORE$=CHR$(VAL(A$))+CHR$(VAL(B$))
  38.         READ #1,6;A$,B$,C$
  39.         CLRBACK$=CHR$(VAL(A$))+CHR$(VAL(B$))
  40.         READ #1,7;A$,B$,C$
  41.         HIGH$=CHR$(VAL(A$))+CHR$(VAL(B$))
  42.         READ #1,8;A$,B$,C$
  43.         LOW$=CHR$(VAL(A$))+CHR$(VAL(B$))
  44.         READ #1,9;A$,B$,C$
  45.         HOME$=CHR$(VAL(A$))+CHR$(VAL(B$))
  46.         READ #1,13;A$,B$,C$
  47.         ROWOFF=VAL(A$):COLOFF=VAL(B$):SCRPARA=VAL(C$)
  48.         CLOSE 1
  49.  
  50.         REM MASK INITIALIZATION GOES HERE
  51.  
  52.         REM PASSWORD ROUTINE GOES HERE
  53.  
  54. 7       GOTO 11
  55.  
  56. 8       REM VERTICAL CURSOR POSITIONING ROUTINE
  57.         FOR ZZ=1 TO VV:PRINT:NEXT ZZ:RETURN
  58.  
  59. 9       REM DATE FORMATTING ROUTINE
  60.         DATE$=MID$(P$,1,2)+"-"+MID$(P$,3,2)+"-"+MID$(P$,5,2)
  61.         RETURN
  62.  
  63. 10      REM  CURSOR ADDRESS
  64.         IF SCRPARA=1 THEN \
  65.         PRINT CRSR$;CHR$(ROW+ROWOFF);CHR$(COLUMN+COLOFF);:RETURN
  66.         PRINT CRSR$;CHR$(COLUMN+COLOFF);CHR$(ROW+ROWOFF);:RETURN
  67.  
  68. 11      REM GET DATE HERE
  69.         READ #2,1;A2$,B2$,C2$,D2$,E2$,F2$,G2$,H2$,I2$,J2$
  70.         NAME$=B2$:LINE$="":CONO$=I2$:ORG$=J2$
  71.         FOR X=1 TO LEN(NAME$):LINE$=LINE$+"*":NEXT X
  72.         P$=H2$:GOSUB 9
  73.  
  74. 15      REM COMPANY INFO HERE
  75.         GOTO 150        
  76.  
  77. 93      REM  ** GET DATE AND ID AND TIME FROM OPERATOR **
  78.         PRINT CLEAR$:VV=8:GOSUB 8:P=0
  79.         PRINT TAB(20);"WHAT IS THE DATE (MMDDYY) : ";:INPUT "";LINE P$
  80.         Q8=VAL(MID$(ORG$,5,2))
  81.         IF VAL(MID$(P$,5,2))<Q8 THEN 93
  82.         L=LEN(P$):Q9=ABS((18-VAL(MID$(P$,1,2)))-(18-VAL(MID$(ORG$,1,2))))
  83.         IF L=6 AND Q9=6 THEN J2$=P$:GOSUB 2900:GOTO 95
  84.         IF L=6 AND Q9<>6 THEN NOGO$="X":GOTO 95
  85.         GOTO 93
  86.  
  87. 95      REM ** IF SIX MONTHS HAVE PASSED THEN PRINT MESSAGE **
  88.         PRINT #2,1;F1$,B2$,C2$,D2$,E2$,F2$,G2$,P$,I2$,J2$
  89.         GOSUB 9
  90.  
  91. 100     IF NOGO$="X" THEN GOSUB 4000
  92.         GOTO 150
  93.  
  94. 101     CHAIN "NADSCRN"
  95. 102     CHAIN "NADREPT"
  96. 103     CHAIN "NADMAIL"
  97. 104     CHAIN ""
  98. 105     CHAIN ""
  99. 106     CHAIN ""
  100. 107     CHAIN ""
  101. 108     CHAIN ""
  102. 109     CHAIN ""
  103. 110     GOTO 93
  104. 111     PRINT CLEAR$:STOP
  105.      
  106. 150     GOSUB 2000:PRINT TAB(29);"* * * MAIN MENU * * *"
  107.         PRINT:PRINT:PRINT:PRINT
  108.         PRINT TAB (26);" 1. NAME & ADDRESS ENTRY"
  109.         PRINT TAB (26);" 2. NAME & ADDRESS REPORT"
  110.         PRINT TAB (26);" 3. MAILING LABELS"
  111.         PRINT TAB (26);" 4. "
  112.         PRINT TAB (26);" 5. "
  113.         PRINT TAB (26);" 6. "
  114.         PRINT TAB (26);" 7. CHANGE DATE"
  115.  
  116. 155     COLUMN=14:ROW=22:GOSUB 10:PRINT EOS$;
  117.         PRINT "TYPE THE NUMBER OF YOUR REQUEST : ";:Y%=CONCHAR%:Y=Y%-48
  118.         IF Y%=94 THEN 9990
  119.         IF Y=7 THEN 160
  120.         IF Y<1 OR Y>3 THEN 155
  121.  
  122. 160     GOSUB 8802:COLUMN=14:ROW=22:GOSUB 10:PRINT EOL$;
  123.         PRINT "Please have patience ... Now loading your selection ";Y;
  124.         ON Y GOTO 101,102,103,104,105,106,110
  125.  
  126. 1000    REM READ #2,1;A2$,B2$,C2$,D2$,E2$,F2$,G2$,H2$,I2$,J2$
  127.         REM PRINT #2,1;A2$,B2$,C2$,D2$,E2$,F2$,G2$,H2$,I2$,J2$
  128.         CLOSE 2:GOTO 9990
  129.  
  130. 1500    REM FILE I/O HERE
  131.  
  132. 1503    READ #3,REC3;A3$
  133.         RETURN
  134.  
  135. 2000    PRINT CLEAR$:PRINT:PRINT:PRINT TAB(2);NAME$;TAB(70);DATE$
  136.         PRINT TAB(2);LINE$;TAB(70);"REV ";REV$:PRINT:RETURN
  137.   
  138. 2503    PRINT #3,REC3;A3$
  139.         RETURN
  140.  
  141. 2900    PRINT CLEAR$:VV=7:GOSUB 8
  142.         PRINT TAB(20);"IT HAS NOW BEEN 6 MONTHS SINCE YOU HAVE RECEIVED"
  143.         PRINT TAB(20);"YOUR PROGRAMS.":PRINT
  144.         PRINT TAB(20);"WE HAVE BEEN CONSTANTLY IMPROVING & DEVELOPING"
  145.         PRINT TAB(20);"NEW PROGRAMS, SO - - -":PRINT
  146.         PRINT TAB(20);"PLEASE CALL US AT (916) 366-7840 FOR INFORMATION"
  147.         PRINT TAB(20);"REGARDING OUR NEW DEVELOPMENTS & UPDATES"
  148.         PRINT:PRINT:PRINT TAB(48);"Creative Data"
  149.         PRINT:PRINT TAB(25);"PRESS RETURN ";:Y%=CONCHAR%
  150.         J2$=P$:RETURN
  151.  
  152. 3000    REM  ** INITIALIZE DEMO DISK IF PRESENT **
  153.         RETURN
  154.  
  155. 3040    REM DISK ROUTINE HERE
  156.         PRINT CLEAR$:CONSTAB=20
  157.         FOR X=1 TO 8:PRINT:NEXT X
  158.         PRINT TAB(CONSTAB);"PLEASE HAVE PATIENCE. THIS MODULE IS NOT ";
  159.         PRINT "IMPLEMENTED":PRINT TAB(CONSTAB);
  160.         PRINT "YET. PLEASE CONTACT Creative Data FOR THE FUTURE DATE ";
  161.         PRINT TAB(CONSTAB);"OF RELEASE. THANK-YOU":PRINT:PRINT
  162.         PRINT TAB(CONSTAB);"PRESS 'RETURN' WHEN READY : ";:Y%=CONCHAR%
  163.         PRINT CLEAR$:GOTO 150
  164.  
  165. 4000    REM  ** ENTRY SCREEN **
  166.         PRINT CLEAR$
  167.         PRINT TAB(21);"***********************************"
  168.         PRINT TAB(21);"*";TAB(55);"*"
  169.         PRINT TAB(21);"*     NAME & ADDRESS PROGRAM      *"
  170.         PRINT TAB(21);"*";TAB(55);"*"
  171.         PRINT TAB(21);"***********************************"
  172.         PRINT:PRINT:PRINT TAB(32);"VERSION ";REV$
  173.         PRINT:PRINT:PRINT TAB(31);"Creative Data"
  174.         PRINT TAB(30);"3208 MAGICWOODS"
  175.         PRINT:PRINT TAB(28);"SACRAMENTO, CA 95827"
  176.         PRINT:PRINT TAB(30);"(916) 366-7840"
  177.         PRINT:PRINT TAB(30);"J.Butler (Pgmr)":PRINT
  178.         PRINT TAB(30);"(PRESS RETURN) ";:Y%=CONCHAR%
  179.         RETURN
  180.  
  181. 6000    REM INPUT INFO
  182.         Y$=""
  183.  
  184. 6001    POKE DIO,0:CALL DIO+1
  185.         CHR%=PEEK(DIO) AND 127
  186.         IF CHR%=0 THEN 6001
  187.         IF CHR%=8 AND LEN(Y$)<1 THEN 6001
  188.         IF CHR%=27 THEN 9990
  189.         IF CHR%=13 THEN RETURN
  190.         IF CHR%=8  THEN Y$=LEFT$(Y$,LEN(Y$)-1):PRINT CHR$(8);" ";CHR$(8);
  191.         IF CHR%<32 OR CHR%>122 THEN 6001
  192.         PRINT CHR$(CHR%);:Y$=Y$+CHR$(CHR%):GOTO 6001
  193.  
  194. 8802    ROW=ROW-1:GOSUB 10:PRINT EOS$:RETURN
  195.  
  196. 8900    RETURN
  197.  
  198. 9000    REM DIRECT CONSOLE I/O                               DB
  199.         DATA 0,229,213,197,245,30,255,14,6,205,5,0,183,202,5,219,50,0
  200.         DATA 219,241,193,209,225,201,0
  201.         REM   DB 
  202.  
  203. 9990    PRINT LOW$;CLEAR$:STOP
  204.  
  205. 9992    FOR X=1 TO 24:PRINT:NEXT X
  206.         PRINT TAB(20);"ACCESS NOT PERMITTED! SEE YOUR SYSTEM SUPERVISOR..";ERR;
  207.         Y%=CONCHAR%
  208.         IF Y%=5EH THEN 9990
  209.         GOTO 9992
  210.  
  211.  
  212.