home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol163 / nadscrn.bas < prev    next >
Encoding:
BASIC Source File  |  1984-04-29  |  5.7 KB  |  172 lines
  1.         REM NADSCRN.BAS   * PROGRAM TO SET UP NAME & ADDRESSES   *
  2.         REM               * 2300
  3.         REM 05 29 83      * J.BUTLER
  4.         REM SYSTEM CONTROL PROGRAM NUMBER    :
  5.  
  6.         REM COMMONS GO HERE
  7.         COMMON CLEAR$,NAME$,LINE$,DEMO$,CRSR$,EOL$,DATE$,ID$,SCRPARA,EOS$
  8.         COMMON ROWOFF,COLOFF,DIO
  9.  
  10.         REM DIMENSIONS GO HERE
  11.         DIM MONTHS$(12),CA$(10),CA(10)
  12.         REV$="052983"
  13.         BLANK$="........................................................":ERR=1
  14.  
  15. 7       REM OPEN PARTICULAR FILE HERE
  16.         ERR=5.1
  17.         IF END #1 THEN 9992
  18.         OPEN "NAD.FIL" RECL 224 AS 1
  19.         REC1=0:GOSUB 1000:NEXTREC=VAL(CA$(2)):RECEND%=0
  20.         IF NEXTREC=0 THEN NEXTREC=1
  21.         IF END #1 THEN 7.5
  22.         FOR F%=14 TO 1 STEP-1
  23.         READ #1,2^F%+RECEND%;LINE X$
  24.         RECEND%=RECEND%+2^F%
  25.  
  26. 7.5     NEXT F%
  27.         RECEND$=STR$(RECEND%):NEXTREC=RECEND%-1:GOTO 11
  28.  
  29. 8       REM VERTICAL CURSOR POSITIONING ROUTINE
  30.         FOR ZZ=1 TO VV:PRINT:NEXT ZZ:RETURN
  31.  
  32. 9       REM DATE FORMATTING ROUTINE
  33.         DATE$=MID$(P$,1,2)+"-"+MID$(P$,3,2)+"-"+MID$(P$,5,2)
  34.         RETURN
  35.  
  36. 10      REM CURSOR ADDRESS
  37.         IF SCRPARA=1 THEN \
  38.         PRINT CRSR$;CHR$(ROW+ROWOFF);CHR$(COLUMN+COLOFF);:RETURN
  39.         PRINT CRSR$;CHR$(COLUMN+COLOFF);CHR$(ROW+ROWOFF);:RETURN
  40.  
  41. 11      REM LENGTHS OF EACH FIELD
  42.         CA(1)=30:CA(2)=30:CA(3)=30:CA(4)=20:CA(5)=2:CA(6)=9:CA(7)=6
  43.         CA(8)=30:CA(9)=14:CA(10)=30
  44.  
  45. 15      REM SCREEN GENERATION HERE
  46.         PRINT CLEAR$:PRINT TAB(40-LEN(NAME$)/2);NAME$
  47.         PRINT TAB(40-LEN(NAME$)/2);LINE$
  48.         PRINT "  CLIENT # ";TAB(62);"DATE:";DATE$
  49.         ROW=7:COLUMN=1:GOSUB 10:PRINT:REM 46+
  50.         PRINT TAB(25);" 1. NAME           : "
  51.         PRINT TAB(25);" 2. ADDRESS #1     : "
  52.         PRINT TAB(25);" 3. ADDRESS #2     : "
  53.         PRINT TAB(25);" 4. CITY           : "
  54.         PRINT TAB(25);" 5. STATE          : "
  55.         PRINT TAB(25);" 6. ZIP CODE       : "
  56.         PRINT TAB(25);" 7. STARTUP DATE   : "
  57.         PRINT TAB(25);" 8. COMPANY REPR.  : "
  58.         PRINT TAB(25);" 9. TELEPHONE #    : "
  59.         PRINT TAB(25);"10. MISCELLANEOUS  : "
  60.         IF SECOND=1 THEN SECOND=0:RETURN
  61.  
  62. 20      PRINT HIGH$;CLRFORE$;:HOLD$=STR$(REC1) 
  63.         COLUMN=11:ROW=3:GOSUB 10:INPUT "";LINE RECORD$
  64.         IF RECORD$="STOP" OR RECORD$="END" THEN 9990
  65.         REC1=VAL(RECORD$)
  66.         IF RECORD$="" THEN REC1=VAL(HOLD$)+1
  67.         IF REC1>NEXTREC THEN 6000
  68.  
  69. 25      PRINT CLRFORE$
  70.         COLUMN=11:ROW=3:GOSUB 10:PRINT REC1:GOSUB 1000:GOSUB 60
  71.  
  72. 30      PRINT LOW$;:COLUMN=11:ROW=22:GOSUB 10
  73.         PRINT "IS THIS DATA CORRECT <Y/N> :";:Y%=CONCHAR%:GOSUB 10:PRINT EOL$;
  74.         IF Y%=13 OR Y%=89 THEN 15
  75.  
  76. 40      REM ERROR CHECKING STATEMENT HERE
  77.         ROW=21:GOSUB 8802:RECUR$="":COLUMN=11:ROW=22:GOSUB 10
  78.         PRINT EOL$;"'S'TOP, 'D'ELETE, 'R'ECUR @, FIELD #  :";
  79.         INPUT "";LINE CHANGE$
  80.         IF LEFT$(CHANGE$,1)="S" THEN GOSUB 2001:GOTO 9990
  81.         IF CHANGE$="" THEN GOSUB 2001:SECOND=1:GOSUB 15:GOTO 20
  82.         IF CHANGE$="D" THEN ONCE=1:X9=REC1+1:GOTO 8900
  83.         IF MID$(CHANGE$,1,1)="R" THEN RECUR$="R" \
  84.            :CHANGE$=MID$(CHANGE$,2,LEN(CHANGE$)-1)
  85.         IF VAL(CHANGE$)=0 THEN 15
  86.         NUM=10
  87.  
  88. 50      IF VAL(CHANGE$)<1 OR VAL(CHANGE$)>NUM THEN 40
  89.         GOSUB 7010
  90.         IF RECUR$="R" AND VAL(CHANGE$)<=NUM THEN \
  91.            CHANGE$=STR$(VAL(CHANGE$)+1):GOTO 50
  92.         GOTO 40
  93.         REM SECOND=1:GOSUB 15:GOSUB 2001:GOTO 25
  94.  
  95. 60      REM SCREEN PRINT HERE
  96.         COLUMN=46
  97.         FOR X=1 TO 10
  98.         ROW=7+X:GOSUB 10
  99.         IF CA$(X)<>"" THEN PRINT CA$(X) ELSE PRINT LEFT$(BLANK$,CA(X))        
  100.         NEXT X
  101.         RETURN
  102.  
  103. 1000    IF END #1 THEN 6000
  104.  
  105. 1001    READ #1,REC1+1;CA$(1),CA$(2),CA$(3),CA$(4),CA$(5),CA$(6),CA$(7), \
  106.                 CA$(8),CA$(9),CA$(10) 
  107.         RETURN
  108.  
  109. 2001    PRINT #1,REC1+1;CA$(1),CA$(2),CA$(3),CA$(4),CA$(5),CA$(6),CA$(7), \
  110.                 CA$(8),CA$(9),CA$(10) 
  111. REM     FOR X=1 TO 10:CA$(X)="":NEXT X
  112.         RETURN
  113.  
  114. 6000    COLUMN=2:ROW=21:GOSUB 10
  115.         PRINT EOL$;"RECORD #";REC1;" HAS NOT BEEN ESTABLISHED ";CHR$(7);
  116.         FOR X=1 TO 200:NEXT X
  117.  
  118. 6010    GOSUB 8802:ROW=21:GOSUB 10
  119.         PRINT EOS$;"DO YOU WANT TO CREATE THIS RECORD <Y/N> : ";:Y%=CONCHAR%
  120.         IF Y%<>89 THEN GOSUB 10:PRINT EOL$:REC1=0:GOTO 20
  121.         SECOND=1:GOSUB 8900:NEXTREC=REC1+6:GOTO 25
  122.  
  123. 7010    REM SCREEN INPUT FUNCTIONS HERE
  124.         Y$="":HOLDIT$=CA$(VAL(CHANGE$)):Y=1
  125.         COLUMN=46:ROW=7+VAL(CHANGE$):GOSUB 10
  126.         PRINT LEFT$(BLANK$,CA(VAL(CHANGE$))):GOSUB 10
  127.  
  128. 7015    POKE DIO,0:CALL DIO+1
  129.         CHR%=PEEK(DIO) AND 127
  130.         IF CHR%=0 THEN 7015
  131.         IF CHR%=8 AND LEN(Y$)<1 THEN 7015
  132.         IF CHR%=27 THEN RECUR$="":RETURN
  133.         IF CHR%=24 THEN 7010
  134.         IF CHR%=13 THEN 7020
  135.         IF CHR%=8  THEN Y$=LEFT$(Y$,LEN(Y$)-1):Y=Y-1:PRINT CHR$(8);" ";CHR$(8);
  136.         IF CHR%<32 OR CHR%>122 THEN 7015
  137.         IF Y>CA(VAL(CHANGE$)) THEN PRINT CHR$(7);:GOTO 7015
  138.         PRINT CHR$(CHR%);:Y$=Y$+CHR$(CHR%):Y=Y+1:GOTO 7015
  139.  
  140. 7018    CA$(VAL(CHANGE$))=HOLDIT$:RETURN
  141.  
  142. 7020    IF Y$=" " THEN CA$(VAL(CHANGE$))="":RETURN
  143.         IF Y$<>"" THEN CA$(VAL(CHANGE$))=Y$ ELSE CA$(VAL(CHANGE$))=HOLDIT$
  144.         RETURN
  145.  
  146. 8802    ROW=ROW-1:GOSUB 10:PRINT EOS$:RETURN
  147.  
  148. 8900    REM DELETE RECORD FUNCTION HERE
  149.         IF ONCE=1 THEN 8902
  150.         FOR X9=REC1+1 TO REC1+6
  151.  
  152. 8902    PRINT #1,X9;"","","","","","","","","",""
  153.         IF ONCE=1 THEN ONCE=0:GOTO 8904
  154.         NEXT X9
  155.  
  156. 8904    IF SECOND=1 THEN SECOND=0:RETURN
  157.         GOTO 15
  158.  
  159. 9990    FOR X=1 TO 10:CA$(X)="":NEXT X
  160.         CA$(2)=STR$(NEXTREC):REC1=0:GOSUB 2001:CLOSE 1
  161.         PRINT LOW$;CLEAR$:CHAIN "NADMENU"
  162.  
  163. 9992    FOR X=1 TO 24:PRINT:NEXT X
  164.         PRINT TAB(20);"ACCESS NOT PERMITTED! SEE YOUR SYSTEM SUPERVISOR..";ERR;
  165.         Y%=CONCHAR%
  166.         IF Y%=5EH THEN 9999
  167.         GOTO 9992
  168.  
  169. 9999    PRINT LOW$;CLEAR$
  170.         STOP
  171.  
  172.