home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload
/
ShartewareOverload.cdr
/
database
/
datamage.zip
/
CODE.ZIP
/
POWRMAIL.BAS
< prev
next >
Wrap
BASIC Source File
|
1991-02-04
|
39KB
|
1,559 lines
'*****************************************************************************
'* *
'* PROGRAM: powrmail.bas - A SALES MAIL MANAGER FOR DATAMAGE *
'* *
'* LAST REVISION: 9/13/'90 *
'* *
'* REVISION WAS: add labels by index and from keyboard - clean it up! *
'* *
'* AUTHOR: Monte Ward *
'* *
'* POWRMAIL.BAS was written for the interpreter in 1984, compiled via the *
'* I.B.M. BASIC compiler V 1.0. I had to do a LOT of work on it before I *
'* made it available as an example of how to load/process a DATAMAGE file. *
'* *
'* Before you can compile/run this program you MUST link in WW.OBJ. This *
'* file was produced by MASM 4.0 and provides BASIC with access to BIOS 10H *
'* interrupt services. The assembler source code (WW.ASM) is also provided.*
'* *
'* See your compiler manual for the ways to make WW.OBJ available to BASIC. *
'* A QB.QLB file is included for the Quick Basic Environment. *
'* *
'*****************************************************************************
COMMON SHARED K%(), FTOT%(), HDG$(), MC%, BYTES%
DECLARE SUB INPT (MAX%, MC%, SEEDSW%, CTRL$, X$)
DECLARE SUB MINPUT (CPTY%, X%, MAX%, ISRSW%, MISW%, ATTR%, CTRL$, PASS$, X$)
DECLARE SUB DECODER (TT1$, IS$)
DECLARE SUB ROUNDOFF (DECS%, RIN#, ROUT#, ROUT$)
DECLARE SUB PARSE.DATE (REV%, WFG%, DC$, T1$, T2$, TT1$, TT2$, DC#)
DECLARE SUB CNTRSTRP (PTL%, CNTR%, CR1$, CR2$, TT1$, TT2$, CR$)
DECLARE FUNCTION GET.CHOICE (LIMIT%, PMPT$())
REM $DYNAMIC
DEF FN.GET.CURR (AB%)
STATIC D%, WFG%
IF K%(AB%, 4) = AB% THEN FN.GET.CURR = AB%: EXIT DEF
D% = 0: WFG% = 0
WHILE D% < RECNO% AND WFG% = 0
D% = D% + 1
IF K%(D%, 4) = AB% THEN WFG% = D%
WEND
FN.GET.CURR = WFG%
END DEF
REDIM CODES%(94), K%(200, 4), FTOT%(4), IXSGTS%(5), SC%(5, 4), PMPT$(10)
REDIM BUFR$(2, 200), IXBUFR$(5), HDG$(200), CU$(94)
REDIM FILE$(2, 2, 50), ETY$(5), CXTRY$(2, 5)
WIDTH 80: COLOR 3, 0: GOSUB 4420: ATTR% = 0: MC% = 7
GOSUB DRAW.BORDER: GOSUB 4402: GOSUB 4412
COLOR 12: LOCATE 13, 12
PRINT "COPYRIGHT 1986 BY H.C.W.P. SOFTWARE. ALL RIGHTS RESERVED."
COLOR 25: LOCATE 23, 19
PRINT "THE MAGE BIDS YOU WELCOME TO VERSION: 3.5";
GOSUB DELAY: COLOR MC%
SH$ = "CD > DIRFILE": GOSUB 8100
GOSUB 420: OPEN "DIRFILE" FOR INPUT AS #1
LINE INPUT #1, I$
CLOSE #1
KILL "DIRFILE": GOSUB 430
ORG.PTH$ = RTRIM$(I$)
IF MID$(ORG.PTH$, LEN(ORG.PTH$), 1) = "\" THEN
B$ = MID$(ORG.PTH$, 1, LEN(ORG.PTH$) - 1): ORG.PTH$ = B$
END IF
60 GOSUB 4402: LOCATE 5, 24: PRINT "HERE'S WHAT YOU NEED TO PROCEED:"
LOCATE 9, 7
PRINT "1. A MARKER FILE (IF USED) CONTAINING RECORDS FOR THE MASS-MAILING."
LOCATE 12, 7
PRINT "2. A CODE (IF USED) TO BE WRITTEN ON THE LABELS AND IN THE RECORDS."
LOCATE 15, 7
PRINT "3. HAVE 4 (W) X 1.5 (H) LABELS READY, BUT DON'T MOUNT THEM YET."
PMPT$(0) = "YOU MAY:"
PMPT$(1) = "1=CONTINUE"
PMPT$(2) = "2=EXIT"
I = GET.CHOICE(2, PMPT$())
IF I <> 1 THEN GOTO 410
GOTO MAIN.MENU
LOAD.FILE:
40 DRIVE$ = MID$(PTH$, 1, 2)
IF DRIVE$ <> "A:" AND DRIVE$ <> "B:" THEN GOTO 80
GOSUB 4412: CR1$ = "PLACE DATA DISK IN " + DRIVE$
CR2$ = "AND PRESS ANY KEY"
PTL% = 23: GOSUB 4470: GOSUB 7600
80 MAX% = 1: GOSUB 3400
IF EXT$ = "FAILED" THEN
GOSUB 4402: LOCATE 13, 18
PRINT "ENTER PATH NAME FOR LOADFILE OR QUIT TO EXIT";
GOSUB 4412: LOCATE 23, 8: PRINT "ENTER PATHNAME: ";
MAX% = 48: CTRL$ = "S": GOSUB 8000
IF X$ = "QUIT" OR X$ = "" THEN GOTO 410
FTOT%(1) = 0
PTH$ = RTRIM$(X$): X$ = PTH$
A$ = MID$(X$, LEN(X$), 1)
IF A$ = "\" THEN PTH$ = MID$(X$, 1, LEN(X$) - 1):
GOTO 40
END IF
X% = INSTR(EXT$, ".")
A$ = MID$(EXT$, 1, X% - 1)
PTH$ = PTH$ + "\" + RTRIM$(A$)
GOSUB 4412: LOCATE 23, 31: PRINT "LOADING DATAFILE...."
A$ = PTH$ + "\HEADINGS.SAD"
GOSUB 420: OPEN A$ FOR INPUT AS #4
SEGNO% = 0
WHILE NOT EOF(4)
SEGNO% = SEGNO% + 1
LINE INPUT #4, HDG$(SEGNO%)
WEND
CLOSE #4
A$ = PTH$ + "\KEY.SAD"
OPEN A$ FOR INPUT AS 4: SEGNO% = 0
WHILE NOT EOF(4)
SEGNO% = SEGNO% + 1
INPUT #4, K%(SEGNO%, 1), K%(SEGNO%, 2), K%(SEGNO%, 3), K%(SEGNO%, 4)
WEND
CLOSE #4
200 DATA 1,1,35,2,1,25,3,1,20,4,1,30,5,1,20,6,1,2,7,1,10,8,1,17,9,1,35,10,1,35,11,1,35
WFG% = 0: D% = 1
RESTORE 200
WHILE WFG% = 0 AND D% < 11
READ Z%, A%, B%
Y% = FN.GET.CURR(Z%)
IF A% <> K%(Y%, 1) OR B% <> K%(Y%, 2) THEN WFG% = 1
D% = D% + 1
WEND
IF WFG% = 1 THEN
WFG% = 0: BEEP: GOSUB 4412
CR1$ = "DATABASE IN: ": CR1$ = CR1$ + PTH$
CR2$ = "NOT FORMATTED FOR POWER MAIL": PTL% = 23
GOSUB 4470: GOSUB DELAY
CLOSE : GOSUB 430: GOTO MAIN.MENU
END IF
BYTES% = 0
FOR D% = 1 TO SEGNO%: BYTES% = BYTES% + K%(D%, 2): NEXT
A$ = PTH$ + "\YOURDATA.RAD"
X = 0: OPEN "R", #4, A$, BYTES%
FOR D% = 1 TO SEGNO%
FIELD #4, X AS DY$, K%(D%, 2) AS BUFR$(1, D%)
X = X + K%(D%, 2)
NEXT: DY$ = ""
I$ = PTH$ + "\CTRLFILE.RAD"
OPEN I$ FOR RANDOM AS #1 LEN = 2
FIELD #1, 2 AS RCNO$
' COUNT ACTIVE RECORDS
RECNO% = LOF(1) / 2: PTR1% = 0
REDIM GDNOS%(RECNO%)
FOR D% = 1 TO RECNO%
GET #1, D%
GDNOS%(D%) = CVI(RCNO$)
IF GDNOS%(D%) > 0 THEN PTR1% = PTR1% + 1
NEXT
REDIM SRT1%(PTR1%): PTR1% = 0
' LOAD ACTIVE RECORDS
FOR D% = 1 TO RECNO%
GET #1, D%: Z% = CVI(RCNO$)
IF Z% > 0 THEN PTR1% = PTR1% + 1: SRT1%(PTR1%) = Z%
NEXT
CLOSE #1: GOSUB 430
' DETECT INDEXING
INDXSW% = 0: IXCTR% = 0: D% = 0
WHILE IXCTR% < 5 AND D% < SEGNO%
D% = D% + 1
IF K%(D%, 1) = 1 AND K%(D%, 3) > 0 THEN
INDXSW% = 1: IXCTR% = IXCTR% + 1
IXSGTS%(IXCTR%) = D%
END IF
WEND
' LOAD INDEX FILE, IF ANY
IF INDXSW% = 1 THEN
REDIM IX%(5, RECNO%)
GOSUB 4412: LOCATE 23, 31: PRINT "LOADING FILE INDEX";
GOSUB 420
A$ = PTH$ + "\FILEINDX.RAD"
OPEN "R", #5, A$, 10
FIELD #5, 2 AS IXBUFR$(1), 2 AS IXBUFR$(2), 2 AS IXBUFR$(3), 2 AS IXBUFR$(4), 2 AS IXBUFR$(5)
FOR D% = 1 TO RECNO%
GET #5, D%
FOR M% = 1 TO 5
IX%(M%, D%) = CVI(IXBUFR$(M%))
NEXT
NEXT
CLOSE #5
END IF
' LOAD CODE HISTORY
CU% = 0
A$ = PTH$ + "\CODESUSD.HTY"
ON ERROR GOTO 435
OPEN A$ FOR INPUT AS #1: GOSUB 420
WHILE NOT EOF(1)
INPUT #1, I$
IF EOF(1) AND I$ = "" THEN GOTO 310
T$ = MID$(I$, 1, 1): X% = ASC(T$)
CODES%(X% - 32) = 1: CU% = CU% + 1
X$ = MID$(I$, 3, LEN(I$))
IF LEN(X$) > 60 THEN X$ = MID$(X$, 1, 60)
CU$(X% - 32) = X$
310 WEND
CLOSE #1: GOSUB 430
IF CU% = 73 THEN
GOSUB 4412: CR1$ = "ALL CODES USED,": CR2$ = "PERFORM RESTART"
PTL% = 23: GOSUB 4470: BEEP: GOSUB DELAY: GOTO 410
END IF
320 RETURN
MASS.LABELS:
IF CRSW% < 4 AND DUP.SW% = 1 THEN
PMPT$(0) = "PRINT LABELS FOR RECORDS CONTAINING CODE: " + CODE$ + "?"
PMPT$(1) = "1=YES"
PMPT$(2) = "2=BYPASS DUPLICATES"
DUP.SW% = GET.CHOICE(2, PMPT$())
ELSE DUP.SW% = 0
END IF
GOSUB ALIGN.LABELS
GOSUB 4412: LOCATE 23, 10
PRINT "LABELS TO PRINT:"; SRNO%;
IF DUP.SW% > 0 THEN PRINT TAB(37); "DUPLICATES:";
PRINT TAB(58); "PRINTED:";
X% = 0: Y% = 0
FOR D% = 1 TO SRNO%
GOSUB 420: GET #4, SRT1%(D%): GOSUB 425
WFG% = 0
IF DUP.SW% AND CRSW% < 4 THEN
Z% = 9
WHILE Z% < 12 AND WFG% = 0
M% = FN.GET.CURR(Z%)
A$ = BUFR$(1, M%)
WFG% = INSTR(A$, CODE$)
Z% = Z% + 1
WEND
END IF
IF WFG% = 0 OR DUP.SW% = 1 THEN
GOSUB SCREEN.LABEL
GOSUB PRINT.LABEL
X% = X% + 1
LOCATE 23, 66: PRINT X%;
ELSE
Y% = Y% + 1
LOCATE 23, 48: PRINT Y%;
END IF
NEXT
GOSUB 430
GOSUB 4402: LOCATE 13, 28
PRINT "PRESS ANY KEY TO CONTINUE";
GOSUB 7600
RETURN
405 RESUME 409
409 COLOR 7, 0, 0: CLS : END
DELAY:
T$ = MID$(TIME$, 7, 2)
T% = VAL(T$)
T% = T% + 4
IF T% > 59 THEN T% = T% - 60
WHILE TT% <> T%
T$ = MID$(TIME$, 7, 2)
TT% = VAL(T$)
WEND
RETURN
420 ON ERROR GOTO 4000: RETURN
425 ON ERROR GOTO 4010: RETURN
430 ON ERROR GOTO 0: RETURN
435 RESUME 320
440 X% = 0: RESUME 4750
PRINT.CODES:
GOSUB 4412: LOCATE 23, 10
PRINT "MAKE THE PRINTER READY, AND PRESS ANY KEY TO BEGIN LISTING.";
GOSUB 7600
GOSUB 4412: LOCATE 23, 29
PRINT "PRODUCING CODE SHEETS";
GOSUB 425: SRSW% = 0
WHILE SRSW% < 2
FOR D% = 1 TO 3: LPRINT : NEXT:
LPRINT STRING$(79, "*"): LPRINT : LPRINT
CR1$ = "MAILOUT REPORT:": CR2$ = "LISTING OF CODES "
IF SRSW% = 0 THEN CR2$ = CR2$ + "USED" ELSE CR2$ = CR2$ + "AVAILABLE"
PTL% = 0: GOSUB 4470: LPRINT TAB(CNTR%); CR$: LPRINT : LPRINT
CR1$ = "DATAFILE IS: ": CR2$ = PTH$: PTL% = 0: GOSUB 4470
LPRINT TAB(CNTR%); CR$; : LPRINT : LPRINT
LPRINT STRING$(79, "*"): LPRINT : LPRINT : LNCTR% = 15
FOR D% = 1 TO 94
A% = D% + 32
IF A% = 34 THEN GOTO SKIP.CODE
IF SRSW% = 0 AND CODES%(D%) = 0 THEN GOTO SKIP.CODE
IF SRSW% = 1 AND CODES%(D%) = 1 THEN GOTO SKIP.CODE
LPRINT "CODE: "; CHR$(A%); TAB(10); "USE: "; CU$(D%)
LPRINT STRING$(79, "|"): LNCTR% = LNCTR% + 2
IF LNCTR% > 59 THEN
LPRINT CHR$(12);
FOR LNCTR% = 1 TO 4: LPRINT : NEXT
END IF
SKIP.CODE:
NEXT
LPRINT CHR$(12); : SRSW% = SRSW% + 1
WEND
SRSW% = 0: GOSUB 430
RETURN
ALIGN.LABELS:
GOSUB 4402: ALIGN% = 0
LOCATE 13, 10
PRINT "MOUNT THE LABELS IN YOUR PRINTER, ALIGN THE LABELS PROPERLY.";
GOSUB 4412: LOCATE 23, 27
PRINT "PRESS ANY KEY WHEN READY:"; : GOSUB 7600
WHILE ALIGN% = 0
GOSUB 425
FOR D% = 1 TO 6: LPRINT "XXXXXXXXXXXXXXXXXXXXX": NEXT
LPRINT : LPRINT : LPRINT
FOR D% = 1 TO 9: LPRINT : NEXT
PMPT$(0) = "PRINT ANOTHER ALIGNMENT LABEL?"
PMPT$(1) = "1=YES"
PMPT$(2) = "2=GENERATE LABELS:"
I = GET.CHOICE(2, PMPT$())
IF I = 2 THEN ALIGN% = 1
WEND
RETURN
SCREEN.LABEL:
GOSUB 4402: LOCATE 9, 28
IF CRSW% < 4 THEN
PRINT STRING$(29, " "); STR$(GDNOS%(SRT1%(D%))); CODE$
END IF
M% = FN.GET.CURR(2)
LOCATE , 28
IF BUFR$(1, M%) <> SPACE$(25) THEN PRINT BUFR$(1, M%)
M% = FN.GET.CURR(3)
LOCATE , 28
IF BUFR$(1, M%) <> SPACE$(20) THEN PRINT BUFR$(1, M%)
M% = FN.GET.CURR(1)
LOCATE , 28
IF BUFR$(1, M%) <> SPACE$(35) THEN PRINT BUFR$(1, M%)
M% = FN.GET.CURR(4)
LOCATE , 28
PRINT BUFR$(1, M%)
M% = FN.GET.CURR(5)
LOCATE , 28
PRINT RTRIM$(BUFR$(1, M%));
M% = FN.GET.CURR(6)
PRINT ", "; BUFR$(1, M%);
M% = FN.GET.CURR(7)
PRINT ". "; BUFR$(1, M%)
RETURN
PRINT.LABEL:
LNCTR% = 1: GOSUB 425
LABELS.DONE% = LABELS.DONE% + 1
IF CRSW% < 4 THEN
LPRINT STRING$(29, " "); STR$(GDNOS%(SRT1%(D%))); CODE$
LNCTR% = LNCTR% + 1
END IF
M% = FN.GET.CURR(2)
IF BUFR$(1, M%) <> SPACE$(25) THEN LPRINT BUFR$(1, M%): LNCTR% = LNCTR% + 1
M% = FN.GET.CURR(3)
IF BUFR$(1, M%) <> SPACE$(20) THEN LPRINT BUFR$(1, M%): LNCTR% = LNCTR% + 1
M% = FN.GET.CURR(1)
IF BUFR$(1, M%) <> SPACE$(35) THEN LPRINT BUFR$(1, M%): LNCTR% = LNCTR% + 1
M% = FN.GET.CURR(4)
LPRINT BUFR$(1, M%): LNCTR% = LNCTR% + 1
M% = FN.GET.CURR(5)
LPRINT RTRIM$(BUFR$(1, M%));
M% = FN.GET.CURR(6)
LPRINT ", "; BUFR$(1, M%);
M% = FN.GET.CURR(7)
LPRINT ". "; BUFR$(1, M%)
LNCTR% = LNCTR% + 1
FOR S% = LNCTR% TO 9: LPRINT : NEXT
' WRITE CODE IN RECORD
IF CRSW% < 3 THEN
Y% = 9: I$ = SPACE$(35)
WHILE (LEN(I$) = 35 AND Y% < 11)
M% = FN.GET.CURR(Y%)
I$ = RTRIM$(BUFR$(1, M%))
Y% = Y% + 1
WEND
IF LEN(I$) THEN I$ = I$ + CODE$ ELSE I$ = CODE$
LSET BUFR$(1, M%) = I$: GOSUB 420
PUT #4, SRT1%(D%)
END IF
GOSUB 430
RETURN
' FIND AND MAKE MENU OF DATAMAGE FILES
3400 IF MAX% = 1 AND FTOT%(1) > 0 THEN GOTO 3452
X% = 1: GOSUB 4412
IF MAX% = 1 THEN
CR1$ = "READING DIRECTORY OF:": CR2$ = PTH$
PTL% = 23: GOSUB 4470: GOTO 3410
END IF
LOCATE 23, 30: PRINT "LOADING MARKER FILES";
3410
X$ = PTH$ + "\DIRFILE"
SH$ = "DIR " + PTH$ + ">" + X$
GOSUB 8100
ON ERROR GOTO 3750: OPEN X$ FOR INPUT AS #1: GOSUB 430
WHILE NOT EOF(1)
LINE INPUT #1, I$
IF I$ = "" OR EOF(1) THEN GOTO 3450
T$ = MID$(I$, 1, 1)
IF T$ = " " OR T$ = "." THEN GOTO 3450
B$ = RTRIM$(MID$(I$, 1, 8))
A$ = PTH$ + "\" + B$
SELECT CASE MAX%
CASE 1:
T$ = "DIR"
IF MID$(I$, 15, 3) = T$ THEN A$ = A$ + "\CITYNAME.SAD" ELSE GOTO 3450
'BREAK
CASE 2:
T$ = "MKR"
IF MID$(I$, 10, 3) = T$ THEN A$ = A$ + ".MKR" ELSE GOTO 3450
'BREAK
END SELECT
3441 B$ = B$ + "." + T$: TT$ = ""
ON ERROR GOTO 3443: OPEN A$ FOR INPUT AS #2
INPUT #2, TT$: GOTO 3444
3443 RESUME 3450
3444 CLOSE #2
IF LEN(TT$) <> 35 THEN GOTO 3450
IF FTOT%(MAXX%) > 49 THEN GOTO 3450
FTOT%(MAX%) = FTOT%(MAX%) + 1
FILE$(MAX%, 1, FTOT%(MAX%)) = B$
FILE$(MAX%, 2, FTOT%(MAX%)) = TT$
3450 WEND
CLOSE #1: KILL X$: GOSUB 430
IF SRSW% = 1 THEN SRSW% = 0: GOTO 3745
3452 IF FTOT%(MAX%) = 0 THEN
CR1$ = "SORRY, NO ": CR2$ = "FILES FOUND."
GOSUB 4412: BEEP: PTL% = 23: GOSUB 4470
GOSUB DELAY: EXT$ = "FAILED": GOTO 3745
END IF
GOSUB 4402: LOCATE 4, 15
PRINT "FILENAME"; TAB(38); "USER-ASSIGNED DESCRIPTION";
COLOR 6: LOCATE 5, 9
PRINT CHR$(201); STRING$(62, CHR$(205)); CHR$(187);
FOR D1% = 6 TO 19
LOCATE D1%, 9: PRINT CHR$(186);
LOCATE D1%, 72: PRINT CHR$(186);
NEXT
LOCATE 20, 9: PRINT CHR$(200); STRING$(62, CHR$(205)); CHR$(188);
COLOR MC%: FT% = 1: FL% = 0: F% = FTOT%(MAX%)
3500 GOSUB 4408
FOR FL% = 0 TO 13
M% = FT% + FL%
IF M% > F% THEN GOTO 3510
LOCATE FL% + 6, 13: PRINT FILE$(MAX%, 1, M%);
LOCATE , 33: PRINT FILE$(MAX%, 2, M%);
3510 NEXT: FL% = FL% - 1
IF FL% > F% - 1 THEN FL% = F% - 1
3515 GOSUB 4412: COLOR 6: LOCATE 23, 12
PRINT "MOVEMENT KEYS: "; CHR$(24); CHR$(25);
PRINT " PgDn PgUp Home End Esc RET = SELECT FILE";
3525 COLOR 25: LOCATE FL% + 6, 13
PRINT FILE$(MAX%, 1, FT% + FL%); : COLOR MC%
IF SRSW% = 1 THEN
SRSW% = 0: LOCATE , 33: PRINT FILE$(MAX%, 2, FT% + FL%);
END IF
GOSUB 7600: LOCATE FL% + 6, 13
PRINT FILE$(MAX%, 1, FT% + FL%); : COLOR MC%
IF LEN(I$) = 2 THEN GOTO 3650
3570 M% = ASC(I$)
IF M% = 13 THEN EXT$ = FILE$(MAX%, 1, FT% + FL%): GOTO 3745
IF M% = 27 THEN EXT$ = "FAILED": GOTO 3745
BEEP: GOTO 3525
3650 T$ = MID$(I$, 2, 1): X% = ASC(T$)
SELECT CASE X%
CASE 71: GOTO 3500' HOME
CASE 79: 'END
FT% = F% - 13
IF FT% < 1 THEN FT% = 1
GOTO 3500
CASE 81: ' PAGE DOWN
FT% = FT% + 14: IF FT% > (F% - 14) THEN FT% = F% - 13
IF FT% < 1 THEN FT% = 1
GOTO 3500
CASE 73: ' PAGE UP
FT% = FT% - 14
IF FT% < 1 THEN FT% = 1
GOTO 3500
CASE 80: ' LINE DOWN
IF FT% + FL% >= F% THEN BEEP: GOTO 3525
IF FL% < 13 THEN FL% = FL% + 1: GOTO 3525
FT% = FT% + 1: GOSUB 4437: SRSW% = 1: GOTO 3525
CASE 72: ' LINE UP
IF FL% = 0 AND FT% = 1 THEN BEEP: GOTO 3525
IF FL% > 0 THEN FL% = FL% - 1: GOTO 3525
FT% = FT% - 1
IF FT% = 0 THEN FTSW% = 1: BEEP: GOTO 3525
GOSUB 4447: SRSW% = 1: GOTO 3525
CASE ELSE: BEEP: GOTO 3525
END SELECT
3745 CLOSE #2: RETURN
3750 EXT$ = "FAILED": RESUME 3745
' DISK ERROR ROUTINE
4000 PMPT$(0) = "DISK"
GOTO 4015
' PRINTER ERROR ROUTINE
4010 GOSUB 4412: BEEP: LOCATE 23, 18
PMPT$(0) = "PRINTER"
4015 PMPT$(0) = PMPT$(0) + " ERROR:"
PMPT$(1) = "1=RETRY"
PMPT$(2) = "2=ABORT PROGRAM"
BEEP: I = GET.CHOICE(2, PMPT$())
IF I = 1 THEN RESUME
RESUME 410
' CALLS TO BIOS TO HANDLE SCREEN VIA WW.OBJ LINKED IN
4402 CALL WW(ATTR%, 19, 78, 1, 1, 0, 7): RETURN
4408 CALL WW(ATTR%, 18, 70, 5, 9, 0, 7): RETURN
4412 CALL WW(ATTR%, 23, 78, 21, 1, 0, 7): RETURN
4420 CALL WW(ATTR%, 0, 0, 32, 0, 0, 1): RETURN
4437 CALL WW(ATTR%, 18, 70, 5, 9, 1, 6): RETURN
4447 CALL WW(ATTR%, 18, 70, 5, 9, 1, 7): RETURN
4465 'LINE INPUT; X$:RETURN
X$ = SPACE$(MAX%): CALL MINPUT(CPTY%, X%, MAX%, ISRSW%, MISW%, ATTR%, CTRL$, PASS$, X$): COLOR MC%, 0: RETURN
4470 CALL CNTRSTRP(PTL%, CNTR%, CR1$, CR2$, TT1$, TT2$, CR$): RETURN
4510 GOSUB 4412: LOCATE 23, 6
PRINT "SEARCHING"; (SCTR%); "INDEX(S)"; TAB(32); "TO SEARCH:"; RECNO%; TAB(53); "RECORDS SEARCHED:";
RETURN
' KEYBOARD WAIT (PRESS ANY KEY)
7600 I$ = "": WHILE I$ = "": I$ = INKEY$: WEND: RETURN
' CALL INPUT ROUTINE
8000 'LINE INPUT; X$:RETURN
CALL INPT(MAX%, MC%, SEEDSW%, CTRL$, X$): RETURN
' GET COMMAND.COM SERVICES
8100 A# = FRE(""): LOCATE 1, 1: SHELL SH$
DRAW.BORDER:
LOCATE 1, 1: COLOR 3
PRINT CHR$(201); STRING$(29, CHR$(205)); "[";
COLOR 12: PRINT " D A T A M A G E "; :
COLOR 3: PRINT "]"; STRING$(29, CHR$(205)); CHR$(187);
FOR D% = 2 TO 24
LOCATE D%, 1: PRINT CHR$(186); : LOCATE D%, 80: PRINT CHR$(186);
NEXT
LOCATE 21, 1
PRINT CHR$(204); STRING$(78, CHR$(205)); CHR$(185);
LOCATE 25, 1
PRINT CHR$(200); STRING$(28, CHR$(205)); "[";
COLOR 11: PRINT " SALES MAIL MANAGER ";
COLOR 3: PRINT "]"; STRING$(28, CHR$(205)); CHR$(188);
COLOR MC%
RETURN
DESPACER:
IS$ = ""
FOR M% = 1 TO LEN(TT1$)
C$ = MID$(TT1$, M%, 1): IF C$ = " " THEN GOTO 7660
IS$ = IS$ + C$
7660 NEXT: RETURN
GET.CODE:
GOSUB 4402: LOCATE 5, 34: PRINT "CODEING MENU"
LOCATE 8, 16: PRINT "1. LIST USED AND AVAILABLE CODES TO THE PRINTER"
LOCATE 11, 16: PRINT "2. WRITE CODE ON LABELS, RECORD IN THE DATABASE"
LOCATE 14, 16: PRINT "3. WRITE CODE ON LABELS, DO NOT RECORD THE CODE"
LOCATE 17, 16: PRINT "4. BYPASS ALL CODEING OF THIS LABEL PRINTOUT"
PMPT$(0) = "CODE OPTION:"
PMPT$(1) = "1=PRINT"
PMPT$(2) = "2=WRITE & RECORD"
PMPT$(3) = "3=WRITE ONLY"
PMPT$(4) = "4=BYPASS"
CRSW% = GET.CHOICE(4, PMPT$())
IF CRSW% = 4 OR CRSW% = 1 THEN GOTO 1000
945 GOSUB 4412: LOCATE 23, 15
PRINT "PRESS A ONE LETTER CODE TO REPRESENT THIS MAILOUT:";
GOSUB 7600: X% = ASC(I$)
IF X% < 32 OR X% > 126 OR X% = 34 THEN
BEEP: GOSUB 4412: LOCATE 23, 27
PRINT "INVALID ENTRY, TRY AGAIN."; : GOSUB DELAY: GOTO 945
END IF
CODE$ = I$: DUP.SW% = 0
IF CODES%(X% - 32) = 1 THEN
DUP.SW% = 1
BEEP: GOSUB 4402
LOCATE 11, 28: PRINT "THIS CODE HAS BEEN USED";
CR1$ = "PURPOSE WAS:"
CR2$ = CU$(X% - 32)
PTL% = 13: GOSUB 4470
PMPT$(0) = "USE THIS CODE?"
PMPT$(1) = "1=YES"
PMPT$(2) = "2=NO"
I = GET.CHOICE(2, PMPT$())
IF I = 2 THEN GOTO 945
END IF
IF CRSW% = 3 THEN GOTO 1000
IF DUP.SW% = 0 THEN
GOSUB 4412: LOCATE 23, 10
PRINT "ENTER DESCRIPTION: ";
CTRL$ = "S": MAX% = 40: GOSUB 8000
NC$ = CODE$ + " " + X$
END IF
1000 GOSUB 4402: CR1$ = "YOUR CHOICE WAS: "
SELECT CASE CRSW%
CASE 1: CR2$ = "LIST CODES TO THE PRINTER"
CASE 2: CR2$ = "WRITE CODE AND RECORD IT IN THE DATABASE"
CASE 3: CR2$ = "WRITE CODE, BUT DO NOT RECORD"
CASE 4: CR2$ = "BYPASS THE CODEING OPERATIONS"
END SELECT
1025 PTL% = 13: GOSUB 4470
IF LEN(CODE$) THEN
CR1$ = "CODE ENTERED IS: ": CR2$ = CODE$: PTL% = 16: GOSUB 4470
END IF
PMPT$(0) = "YOU MAY:"
PMPT$(1) = "1=CONTINUE"
PMPT$(2) = "2=RE-ENTER CHOICE"
I = GET.CHOICE(2, PMPT$())
IF I = 2 THEN BEEP: GOTO GET.CODE
IF CRSW% = 1 THEN GOSUB PRINT.CODES: GOTO GET.CODE
IF CRSW% = 2 AND DUP.SW% = 0 THEN
A$ = PTH$ + "\CODESUSD.HTY": GOSUB 420
OPEN A$ FOR APPEND AS #1
PRINT #1, CHR$(34) + NC$ + CHR$(34)
CLOSE #1: GOSUB 430
END IF
RETURN
MAIN.MENU:
WHILE RUNNING% = 0
CLOSE : FTOT%(1) = 0: PTH$ = ORG.PTH$
GOSUB 4402: LOCATE 8, 15
PRINT "1. PRINT LABELS FOR ALL RECORDS IN SOURCE DATAFILE";
LOCATE 10, 15
PRINT "2. PRINT LABELS FOR THE RECORDS IN A MARKER FILE";
LOCATE 12, 15
PRINT "3. PRINT LABELS FOR RECORDS FOUND VIA INDEX SEARCH";
LOCATE 14, 15
PRINT "4. ENTER DATA FOR THE LABEL(S) FROM THE KEYBOARD";
LOCATE 16, 15
PRINT "5. EXIT THE POWER MAIL PROGRAM AND RUN THE GO PGRM";
PMPT$(0) = "MAKE LABELS FOR:"
PMPT$(1) = "1=ALL RECORDS"
PMPT$(2) = "2=MARKER FILE"
PMPT$(3) = "3=SEARCH"
PMPT$(4) = "4=KEYBOARD"
PMPT$(5) = "3=EXIT"
MKR% = GET.CHOICE(5, PMPT$())
SELECT CASE MKR%
CASE 1:
GOSUB LOAD.FILE
SRNO% = 0
FOR D% = 1 TO RECNO%
IF GDNOS%(D%) THEN SRNO% = SRNO% + 1: SRT1%(SRNO%) = D%
NEXT
GOSUB GET.CODE
GOSUB MASS.LABELS
CASE 2:
GOSUB LOAD.FILE
MAX% = 2: GOSUB 3400
IF EXT$ = "FAILED" THEN BEEP: GOTO MAIN.MENU
A$ = PTH$ + "\" + EXT$
GOSUB 4412: LOCATE 23, 30
PRINT "LOADING MARKER FILE";
GOSUB 420: OPEN A$ FOR BINARY AS #2
O$ = SPACE$(37): GET #2, , O$
B$ = SPACE$(40): GET #2, , B$
Z% = CVI(MID$(B$, 1, 2))
CSW% = CVI(MID$(B$, 3, 2))
O$ = SPACE$(48): GET #2, , O$
T% = 2
IF CSW% THEN
IF CSW% = 3 THEN T% = T% + 16 ELSE T% = T% + 8
END IF
O$ = SPACE$(T%): A% = 0
FOR D% = 1 TO Z%
GET #2, , O$
SRT1%(A%) = CVI(MID$(O$, 1, 2))
IF SRT1%(A%) THEN A% = A% + 1
NEXT
CLOSE #2: GOSUB 430
IF A% = 0 THEN
GOSUB 4412: LOCATE 23, 25
PRINT "LOADING OF MARKER FILE FAILED";
BEEP: GOSUB DELAY: RESET: GOTO MAIN.MENU
END IF
SRNO% = A%
CLOSE #1: GOSUB 430
GOSUB GET.CODE
GOSUB MASS.LABELS
CASE 3:
GOSUB LOAD.FILE
GOSUB GET.CODE
GOSUB ALIGN.LABELS
WFG4% = 1: CR% = 0
WHILE WFG4% = 1
4650 IF INDXSW% = 0 THEN
I = 1
ELSE
PMPT$(0) = "TARGET OF SEARCH:"
PMPT$(1) = "1=RECORD NUMBERS"
PMPT$(2) = "2=FILE INDEXES"
PMPT$(3) = "3=QUIT"
I = GET.CHOICE(3, PMPT$())
END IF
SELECT CASE I
CASE 1:
4700 GOSUB 4412: LOCATE 23, 6
PRINT "ENTER THE NUMBER OF THE RECORD TO BE ACCESSED, OR 0 TO ABORT: ";
CTRL$ = "N": MAX% = 5: GOSUB 8000: A = VAL(X$)
IF A = 0 THEN
IF INDXSW% = 0 THEN WFG4% = 0
GOTO 4799
END IF
IF A < 1 OR A > 32727 OR INT(A) < A THEN
CR1$ = "ILLEGAL RECORD NUMBER:"
CR2$ = STR$(A): PTL% = 23
BEEP: GOSUB 4412: GOSUB 4470
GOSUB DELAY: GOTO 4700
END IF
GOSUB 4412: LOCATE 23, 28: PRINT "CHECKING RECORD NUMBERS...";
M% = 0: GPNO% = 0
WHILE GPNO% = 0 AND M% < PTR1%
M% = M% + 1
IF GDNOS%(SRT1%(M%)) = A THEN GPNO% = M%
WEND
IF GPNO% = 0 THEN
GOSUB 4412: BEEP
CR1$ = "RECORD NUMBER:"
CR2$ = STR$(A) + " WAS NOT FOUND!"
CR% = 0: PTL% = 23: GOSUB 4470
GOSUB DELAY: GOTO 4700
END IF
D% = GPNO%
GOSUB 420: GET #4, SRT1%(D%)
' DETECT DUPLICATE
Z% = 9: WFG8% = 0
WHILE Z% < 12 AND WFG8% = 0
A$ = BUFR$(1, Z%)
WFG8% = INSTR(A$, CODE$)
Z% = Z% + 1
WEND
IF WFG8% > 0 AND CRSW% < 4 THEN
GOSUB 4412: BEEP: LOCATE 23, 19
PRINT "THE RECORD FOUND ALREADY CONTAINS CODE: "; CODE$;
GOSUB DELAY
END IF
GOSUB SCREEN.LABEL
PMPT$(0) = "PRINT THIS LABEL?"
PMPT$(1) = "1=YES"
PMPT$(2) = "2=NO"
I = GET.CHOICE(2, PMPT$())
IF I = 1 THEN
GOSUB PRINT.LABEL
END IF
CASE 2:
FOR D% = 1 TO 5: ETY$(D%) = "": NEXT
4740 GOSUB 4402: WFG% = 0: SCTR% = 0
FOR Z% = 1 TO IXCTR%
X% = IXSGTS%(Z%): PASS$ = ETY$(Z%)
T$ = "ENTER: " + HDG$(X%): COLOR 25:
LOCATE ((Z% - 1) * 3) + 5, 4: PRINT T$; TAB(40);
CTRL$ = "S": MAX% = K%(X%, 2)
MISW% = 1: GOSUB 4465
TT$ = SPACE$(LEN(T$)): LSET TT$ = HDG$(X%)
LOCATE ((Z% - 1) * 3) + 5, 4: PRINT TT$;
IF LEN(X$) = 0 THEN ETY$(Z%) = "": GOTO 4745
SCTR% = SCTR% + 1: ETY$(Z%) = X$
SC%(SCTR%, 1) = Z%: SC%(SCTR%, 2) = X%
TT1$ = X$
' INDEX FIELD
X% = -32768: CALL DECODER(X$, IS$)
FOR B% = 1 TO LEN(IS$)
T$ = MID$(IS$, B%, 1)
Y% = ASC(T$)
M% = (Y% MOD B%)
ON ERROR GOTO 440
4750 IF M% = 0 THEN
X% = X% + Y%
ELSE X% = X% + (Y% + B%) * M%
END IF
GOSUB 430
NEXT
SC%(SCTR%, 4) = X%
PMPT$(0) = "SEARCH MODE:"
PMPT$(1) = "1=IGNORE CASE/SPACING"
PMPT$(2) = "2=STRICT EQUALITY"
SC%(SCTR%, 3) = GET.CHOICE(2, PMPT$())
IF SC%(SCTR%, 3) = 2 THEN TT1$ = X$: GOSUB DESPACER
CXTRY$(1, SCTR%) = IS$
4745 NEXT
IF SCTR% = 0 THEN BEEP: GOTO 4799
GOSUB 4510: WFG2% = 0: D% = 0
WHILE D% < PTR1% AND WFG2% = 0
D% = D% + 1: CR% = D%
LOCATE , 70: PRINT D%;
WFG% = 0
FOR C% = 1 TO SCTR%
IDX% = SC%(C%, 4)
IF SRSW% = 0 THEN G% = SRT1%(D%) ELSE G% = Z%
IF IX%(SC%(C%, 1), G%) = IDX% THEN P% = C%: WFG% = WFG% + 1
NEXT
IF WFG% < SCTR% THEN WFG% = 1: GOTO 4757
FOR C% = 1 TO SCTR%
GOSUB 420: GET #4, G%: GOSUB 430
TT1$ = BUFR$(1, SC%(C%, 2))
IF SC%(C%, 3) = 1 THEN
CALL DECODER(TT1$, IS$)
ELSE GOSUB DESPACER
END IF
CXTRY$(2, C%) = IS$
NEXT
WFG% = 0
FOR C% = 1 TO SCTR%
IF CXTRY$(1, C%) = CXTRY$(2, C%) THEN WFG% = WFG% + 1
NEXT
IF WFG% < SCTR% THEN WFG% = 1 ELSE WFG% = 0
4757 IF WFG% = 1 THEN GOTO 4770
GOSUB 420: GET #4, SRT1%(D%)
GOSUB SCREEN.LABEL
' DETECT DUPLICATE
Z% = 9: WFG8% = 0
WHILE Z% < 12 AND WFG8% = 0
A$ = BUFR$(1, Z%)
WFG8% = INSTR(A$, CODE$)
Z% = Z% + 1
WEND
IF WFG8% AND CRSW% < 4 THEN
GOSUB 4412: BEEP: LOCATE 23, 19
PRINT "THE RECORD FOUND ALREADY CONTAINS CODE: "; CODE$;
GOSUB DELAY
END IF
PMPT$(0) = "YOU MAY:"
PMPT$(1) = "1=PRINT AND QUIT"
PMPT$(2) = "2=CONTINUE SEARCH"
PMPT$(3) = "3=PRINT AND CONTINUE"
PMPT$(4) = "4=ABORT"
I = GET.CHOICE(4, PMPT$())
SELECT CASE I
CASE 1:
GOSUB PRINT.LABEL
WFG2% = 1
CASE 2:
CASE 3:
GOSUB PRINT.LABEL
CASE 4:
WFG2% = 1
END SELECT
4770 WEND
IF WFG2% = 1 THEN GOTO 4799
PMPT$(0) = "END OF SEARCH:"
PMPT$(1) = "1=RETRY"
PMPT$(2) = "2=ABORT"
I = GET.CHOICE(2, PMPT$())
IF I = 1 THEN GOTO 4740
CR% = 0: WFG4% = 0
'BREAK
CASE 3: WFG4% = 0
END SELECT
4799 WFG% = 0: WFG1% = 0: WFG2% = 0
WEND
CASE 4:
GOSUB ALIGN.LABELS
GOSUB 430
RESTORE 200: ETG% = 0
FOR SEGNO% = 1 TO 7
READ K%(SEGNO%, 1), K%(SEGNO%, 2), K%(SEGNO%, 3)
K%(SEGNO%, 4) = SEGNO%
NEXT
HDG$(1) = "COMPANY NAME"
HDG$(2) = "CONTACT"
HDG$(3) = "TITLE"
HDG$(4) = "STREET ADDRESS"
HDG$(5) = "CITY"
HDG$(6) = "STATE"
HDG$(7) = "ZIP"
RESTORE 200
WHILE ETG% = 0
GOSUB 4402
FOR X% = 1 TO 7
T$ = "ENTER: " + HDG$(X%): COLOR 25:
LOCATE ((X% - 1) * 2) + 5, 4: PRINT T$; TAB(40);
CTRL$ = "S": MAX% = K%(X%, 3)
MISW% = 1: GOSUB 4465
TT$ = SPACE$(LEN(T$)): LSET TT$ = HDG$(X%)
LOCATE ((X% - 1) * 2) + 5, 4: PRINT TT$;
BUFR$(1, X%) = X$
NEXT
CRSW% = 5: GOSUB SCREEN.LABEL
PMPT$(0) = "PRINT THIS LABEL?"
PMPT$(1) = "1=YES"
PMPT$(2) = "2=NO"
I = GET.CHOICE(2, PMPT$())
IF I = 1 THEN
GOSUB 4412
A$ = STR$(LABELS.DONE%)
CR1$ = MID$(A$, 2)
CR2$ = "LABELS HAVE BEEN PRINTED"
PTL% = 23: GOSUB 4470
GOSUB DELAY
GOSUB 4412: LOCATE 23, 18
PRINT "ENTER NUMBER OF THIS LABEL TO PRINT: ";
CTRL$ = "N": MAX% = 5: GOSUB 8000
X = VAL(X$)
GOSUB 4412: LOCATE 23, 10
PRINT "LABELS TO PRINT: "; X; TAB(48); "LABELS PRINTED:";
FOR Y = 1 TO X
GOSUB PRINT.LABEL
LOCATE 23, 64: PRINT Y
NEXT
END IF
PMPT$(0) = "ENTER ANOTHER LABEL?"
PMPT$(1) = "1=YES"
PMPT$(2) = "2=NO"
I = GET.CHOICE(2, PMPT$())
IF I = 2 THEN ETG% = 1
WEND
CASE 5: RUNNING% = 1
END SELECT
CLOSE
WEND
410 GOSUB 4402: GOSUB 4412: ON ERROR GOTO 405
RESET: CHAIN "GO"