home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol163 / nadmail.bas < prev    next >
Encoding:
BASIC Source File  |  1984-04-29  |  3.8 KB  |  130 lines
  1.         REM NADMAIL.BAS   * PROGRAM TO PRINT NAME & ADDRESSES ON LABELS
  2.         REM               * 2400
  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)
  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.         GOTO 11
  20.  
  21. 8       REM VERTICAL CURSOR POSITIONING ROUTINE
  22.         FOR ZZ=1 TO VV:PRINT:NEXT ZZ:RETURN
  23.  
  24. 9       REM DATE FORMATTING ROUTINE
  25.         DATE$=MID$(P$,1,2)+"-"+MID$(P$,3,2)+"-"+MID$(P$,5,2)
  26.         RETURN
  27.  
  28. 10      REM CURSOR ADDRESS
  29.         IF SCRPARA=1 THEN \
  30.         PRINT CRSR$;CHR$(ROW+ROWOFF);CHR$(COLUMN+COLOFF);:RETURN
  31.         PRINT CRSR$;CHR$(COLUMN+COLOFF);CHR$(ROW+ROWOFF);:RETURN
  32.  
  33. 11      REM START-END ROUTINE HERE
  34.         PRINT CLEAR$:PRINT TAB(40-LEN(NAME$)/2);NAME$
  35.         PRINT TAB(40-LEN(NAME$)/2);LINE$
  36.         PRINT TAB(2);"MAILING LABELS REPORT";TAB(62);"DATE:";DATE$:VV=7:GOSUB 8
  37.         PRINT TAB(25);"STARTING RECORD NO:";:INPUT "";LINE START$
  38.         IF START$="END" OR START$="STOP" THEN 9990
  39.         IF LEN(START$)=0 OR START$="1" THEN START$="2"
  40.         IF VAL(START$)=0 THEN 11
  41.         PRINT:START=VAL(START$)
  42.         IF VAL(START$)<>INT(VAL(START$)) THEN 11
  43.         PRINT TAB(25);"ENDING   RECORD NO:";:INPUT "";LINE RECEND$
  44.         IF ONCE=1 THEN RECEND$=STR$(RECEND):GOTO 11.5
  45.         IF LEN(RECEND$)=0 THEN GOSUB 13:ONCE=1
  46.  
  47. 11.5    PRINT:RECEND=VAL(RECEND$)
  48.         IF VAL(RECEND$)<>INT(VAL(RECEND$)) THEN 11
  49.  
  50. 12      COLUMN=14:ROW=21:GOSUB 10:PRINT EOS$;
  51.         PRINT "DEPRESS 'RETURN' WHEN PRINTER IS READY";:Y%=CONCHAR%
  52.         GOTO 15
  53.  
  54. 13      RECEND%=0
  55.         IF END #1 THEN 14
  56.         FOR F%=14 TO 1 STEP-1
  57.         READ #1,2^F%+RECEND%;LINE X$
  58.         RECEND%=RECEND%+2^F%
  59.  
  60. 14      NEXT F%
  61.         RECEND$=STR$(RECEND%):RETURN
  62.  
  63. 15      REM PRINT GENERATION HERE
  64.         K1=1:M1=0:REC1=START:SUBTOTAL=0:GRANDTOTAL=0:LPRINTER
  65.  
  66. 20      GOSUB 1000
  67.         TEMP=LEN(CA$(1)+CA$(2)+CA$(3)+CA$(4)+CA$(5)+CA$(6))
  68.         IF TEMP<1 THEN 50
  69.         GOTO 60
  70.  
  71. 50      REC1=REC1+1
  72.         IF REC1>RECEND THEN 200
  73.         GOTO 20
  74.  
  75. 60      IF M1>0 THEN 100
  76.         GOSUB 500
  77.  
  78. 100     REM PRINT ONE LINE ON SHEET
  79.         IF M1>=55 THEN PRINT CHR$(12):GOSUB 500:M1=0
  80.         PRINT TAB(2);CA$(1):PRINT TAB(2);CA$(2)
  81.         IF LEN(CA$(3))=0 THEN 110
  82.         PRINT TAB(2);CA$(3)
  83.  
  84. 110     TEMP$=CA$(4)+", "+CA$(5)+". "+CA$(6)
  85.         PRINT TAB(2);TEMP$
  86.         IF LEN(CA$(3))=0 THEN PRINT
  87. REM     SUBTOTAL=SUBTOTAL + ....
  88.         PRINT:PRINT:M1=6:GOTO 50
  89.  
  90. 200     CONSOLE:GOTO 11
  91.  
  92. 500     REM PRINT HEADING INFO
  93.         M1=1:RETURN
  94.  
  95. 600     REM SUBTOTAL ROUTINE
  96.         IF SUBTOTAL=0 THEN RETURN
  97.         PRINT TAB(114);"SUBTOTAL";:PRINT USING S4$;ABS(SUBTOTAL)
  98.         PRINT:PRINT:GRANDTOTAL=GRANDTOTAL+SUBTOTAL:M1=M1+5
  99.         SUBTOTAL=0:RETURN
  100.  
  101. 700     IF GRANDTOTAL=0 THEN RETURN
  102.         PRINT:PRINT TAB(114);"GRANDTOTAL: ";
  103.         PRINT USING S4$;ABS(GRANDTOTAL):GRANDTOTAL=0:RETURN
  104.  
  105. 1000    ERR=5.2
  106.         IF END #1 THEN 6000
  107.  
  108. 1001    READ #1,REC1;CA$(1),CA$(2),CA$(3),CA$(4),CA$(5),CA$(6),CA$(7), \
  109.                 CA$(8),CA$(9),CA$(10) 
  110.         RETURN
  111.  
  112. 6000    PRINT CHR$(12):CONSOLE:COLUMN=2:ROW=22:GOSUB 10
  113.         PRINT EOL$;"RECORD #";REC1;" HAS NOT BEEN ESTABLISHED";CHR$(7);
  114.         FOR X=1 TO 500:NEXT X
  115.         GOSUB 10:PRINT EOL$;:GOTO 12
  116.  
  117. 8802    ROW=ROW-1:GOSUB 10:PRINT EOS$:RETURN
  118.  
  119. 9990    CLOSE 1
  120.         PRINT LOW$;CLEAR$:CHAIN "NADMENU"
  121.  
  122. 9992    FOR X=1 TO 24:PRINT:NEXT X
  123.         PRINT TAB(20);"ACCESS NOT PERMITTED! SEE YOUR SYSTEM SUPERVISOR..";ERR;
  124.         Y%=CONCHAR%
  125.         IF Y%=5EH THEN 9999
  126.         GOTO 9992
  127.  
  128. 9999    PRINT LOW$;CLEAR$
  129.         STOP
  130.