home *** CD-ROM | disk | FTP | other *** search
/ Black Box 4 / BlackBox.cdr / database / datamage.arj / CODE.ZIP / POWRMAIL.BAS < prev    next >
Encoding:
BASIC Source File  |  1991-02-04  |  38.0 KB  |  1,559 lines
  1. '*****************************************************************************
  2. '*                                                                           *
  3. '*  PROGRAM: powrmail.bas - A SALES MAIL MANAGER FOR DATAMAGE                *
  4. '*                                                                           *
  5. '*  LAST REVISION: 9/13/'90                                                  *
  6. '*                                                                           *
  7. '*  REVISION WAS:  add labels by index and from keyboard - clean it up!      *
  8. '*                                                                           *
  9. '*  AUTHOR: Monte Ward                                                       *
  10. '*                                                                           *
  11. '*  POWRMAIL.BAS was written for the interpreter in 1984, compiled via the   *
  12. '*  I.B.M. BASIC compiler V 1.0.  I had to do a LOT of work on it before I   *
  13. '*  made it available as an example of how to load/process a DATAMAGE file.  *
  14. '*                                                                           *
  15. '*  Before you can compile/run this program you MUST link in WW.OBJ.  This   *
  16. '*  file was produced by MASM 4.0 and provides BASIC with access to BIOS 10H *
  17. '*  interrupt services.  The assembler source code (WW.ASM) is also provided.*
  18. '*                                                                           *
  19. '*  See your compiler manual for the ways to make WW.OBJ available to BASIC. *
  20. '*  A QB.QLB file is included for the Quick Basic Environment.               *
  21. '*                                                                           *
  22. '*****************************************************************************                              
  23.  
  24.      COMMON SHARED K%(), FTOT%(), HDG$(), MC%, BYTES%
  25.     
  26.      DECLARE SUB INPT (MAX%, MC%, SEEDSW%, CTRL$, X$)
  27.      DECLARE SUB MINPUT (CPTY%, X%, MAX%, ISRSW%, MISW%, ATTR%, CTRL$, PASS$, X$)
  28.      DECLARE SUB DECODER (TT1$, IS$)
  29.      DECLARE SUB ROUNDOFF (DECS%, RIN#, ROUT#, ROUT$)
  30.      DECLARE SUB PARSE.DATE (REV%, WFG%, DC$, T1$, T2$, TT1$, TT2$, DC#)
  31.      DECLARE SUB CNTRSTRP (PTL%, CNTR%, CR1$, CR2$, TT1$, TT2$, CR$)
  32.     
  33.      DECLARE FUNCTION GET.CHOICE (LIMIT%, PMPT$())
  34.   
  35.    REM $DYNAMIC
  36.  
  37.      DEF FN.GET.CURR (AB%)
  38.  
  39.      STATIC D%, WFG%
  40.  
  41.      IF K%(AB%, 4) = AB% THEN FN.GET.CURR = AB%: EXIT DEF
  42.  
  43.      D% = 0: WFG% = 0
  44.  
  45.      WHILE D% < RECNO% AND WFG% = 0
  46.  
  47.           D% = D% + 1
  48.  
  49.           IF K%(D%, 4) = AB% THEN WFG% = D%
  50.  
  51.      WEND
  52.  
  53.      FN.GET.CURR = WFG%
  54.    
  55.      END DEF
  56.   
  57.    REDIM CODES%(94), K%(200, 4), FTOT%(4), IXSGTS%(5), SC%(5, 4), PMPT$(10)
  58.    REDIM BUFR$(2, 200), IXBUFR$(5), HDG$(200), CU$(94)
  59.    REDIM FILE$(2, 2, 50), ETY$(5), CXTRY$(2, 5)
  60.  
  61.  
  62.    WIDTH 80: COLOR 3, 0: GOSUB 4420: ATTR% = 0: MC% = 7
  63.   
  64.    GOSUB DRAW.BORDER: GOSUB 4402: GOSUB 4412
  65.    
  66.      COLOR 12: LOCATE 13, 12
  67.      PRINT "COPYRIGHT 1986 BY H.C.W.P. SOFTWARE. ALL RIGHTS RESERVED."
  68.  
  69.      COLOR 25: LOCATE 23, 19
  70.      PRINT "THE MAGE BIDS YOU WELCOME TO VERSION:  3.5";
  71.     
  72.      GOSUB DELAY: COLOR MC%
  73.  
  74.    SH$ = "CD > DIRFILE": GOSUB 8100
  75.  
  76.    GOSUB 420: OPEN "DIRFILE" FOR INPUT AS #1
  77.    LINE INPUT #1, I$
  78.    CLOSE #1
  79.  
  80.    KILL "DIRFILE": GOSUB 430
  81.  
  82.      ORG.PTH$ = RTRIM$(I$)
  83.  
  84.      IF MID$(ORG.PTH$, LEN(ORG.PTH$), 1) = "\" THEN
  85.  
  86.           B$ = MID$(ORG.PTH$, 1, LEN(ORG.PTH$) - 1): ORG.PTH$ = B$
  87.  
  88.      END IF
  89.  
  90. 60 GOSUB 4402: LOCATE 5, 24: PRINT "HERE'S WHAT YOU NEED TO PROCEED:"
  91.   
  92.    LOCATE 9, 7
  93.    PRINT "1.  A MARKER FILE (IF USED) CONTAINING RECORDS FOR THE MASS-MAILING."
  94.    LOCATE 12, 7
  95.    PRINT "2.  A CODE (IF USED) TO BE WRITTEN ON THE LABELS AND IN THE RECORDS."
  96.    LOCATE 15, 7
  97.    PRINT "3.  HAVE  4 (W) X 1.5 (H)  LABELS READY, BUT DON'T MOUNT  THEM  YET."
  98.   
  99.    PMPT$(0) = "YOU MAY:"
  100.    PMPT$(1) = "1=CONTINUE"
  101.    PMPT$(2) = "2=EXIT"
  102.   
  103.    I = GET.CHOICE(2, PMPT$())
  104.   
  105.    IF I <> 1 THEN GOTO 410
  106.  
  107.    GOTO MAIN.MENU
  108.  
  109. LOAD.FILE:
  110.  
  111. 40 DRIVE$ = MID$(PTH$, 1, 2)
  112.    IF DRIVE$ <> "A:" AND DRIVE$ <> "B:" THEN GOTO 80
  113.  
  114.    GOSUB 4412: CR1$ = "PLACE DATA DISK IN " + DRIVE$
  115.    CR2$ = "AND PRESS ANY KEY"
  116.    PTL% = 23: GOSUB 4470: GOSUB 7600
  117.  
  118. 80 MAX% = 1: GOSUB 3400
  119.  
  120.      IF EXT$ = "FAILED" THEN
  121.  
  122.           GOSUB 4402: LOCATE 13, 18
  123.           PRINT "ENTER PATH NAME FOR LOADFILE OR QUIT TO EXIT";
  124.  
  125.           GOSUB 4412: LOCATE 23, 8: PRINT "ENTER PATHNAME:  ";
  126.           MAX% = 48: CTRL$ = "S": GOSUB 8000
  127.  
  128.           IF X$ = "QUIT" OR X$ = "" THEN GOTO 410
  129.  
  130.           FTOT%(1) = 0
  131.  
  132.           PTH$ = RTRIM$(X$): X$ = PTH$
  133.          
  134.           A$ = MID$(X$, LEN(X$), 1)
  135.  
  136.           IF A$ = "\" THEN PTH$ = MID$(X$, 1, LEN(X$) - 1):
  137.  
  138.           GOTO 40
  139.  
  140.      END IF
  141.  
  142.     X% = INSTR(EXT$, ".")
  143.     A$ = MID$(EXT$, 1, X% - 1)
  144.     PTH$ = PTH$ + "\" + RTRIM$(A$)
  145.  
  146.     GOSUB 4412: LOCATE 23, 31: PRINT "LOADING DATAFILE...."
  147.    
  148.     A$ = PTH$ + "\HEADINGS.SAD"
  149.    
  150.     GOSUB 420: OPEN A$ FOR INPUT AS #4
  151.  
  152.     SEGNO% = 0
  153.  
  154.     WHILE NOT EOF(4)
  155.    
  156.          SEGNO% = SEGNO% + 1
  157.          LINE INPUT #4, HDG$(SEGNO%)
  158.    
  159.     WEND
  160.  
  161.     CLOSE #4
  162.  
  163.     A$ = PTH$ + "\KEY.SAD"
  164.  
  165.     OPEN A$ FOR INPUT AS 4: SEGNO% = 0
  166.  
  167.     WHILE NOT EOF(4)
  168.    
  169.      SEGNO% = SEGNO% + 1
  170.      INPUT #4, K%(SEGNO%, 1), K%(SEGNO%, 2), K%(SEGNO%, 3), K%(SEGNO%, 4)
  171.    
  172.     WEND
  173.  
  174.     CLOSE #4
  175.  
  176. 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
  177.  
  178.     WFG% = 0: D% = 1
  179.     RESTORE 200
  180.  
  181.     WHILE WFG% = 0 AND D% < 11
  182.            
  183.           READ Z%, A%, B%
  184.          
  185.           Y% = FN.GET.CURR(Z%)
  186.          
  187.           IF A% <> K%(Y%, 1) OR B% <> K%(Y%, 2) THEN WFG% = 1
  188.           D% = D% + 1
  189.  
  190.     WEND
  191.  
  192.     IF WFG% = 1 THEN
  193.  
  194.          WFG% = 0: BEEP: GOSUB 4412
  195.         
  196.          CR1$ = "DATABASE IN: ": CR1$ = CR1$ + PTH$
  197.          CR2$ = "NOT FORMATTED FOR POWER MAIL": PTL% = 23
  198.         
  199.          GOSUB 4470: GOSUB DELAY
  200.       
  201.          CLOSE : GOSUB 430: GOTO MAIN.MENU
  202.  
  203.     END IF
  204.  
  205.     BYTES% = 0
  206.  
  207.     FOR D% = 1 TO SEGNO%: BYTES% = BYTES% + K%(D%, 2): NEXT
  208.  
  209.     A$ = PTH$ + "\YOURDATA.RAD"
  210.  
  211.     X = 0: OPEN "R", #4, A$, BYTES%
  212.  
  213.     FOR D% = 1 TO SEGNO%
  214.  
  215.          FIELD #4, X AS DY$, K%(D%, 2) AS BUFR$(1, D%)
  216.          X = X + K%(D%, 2)
  217.  
  218.     NEXT: DY$ = ""
  219.  
  220.     I$ = PTH$ + "\CTRLFILE.RAD"
  221.     OPEN I$ FOR RANDOM AS #1 LEN = 2
  222.     FIELD #1, 2 AS RCNO$
  223.  
  224. '    COUNT ACTIVE RECORDS
  225.  
  226.      RECNO% = LOF(1) / 2: PTR1% = 0
  227.  
  228.      REDIM GDNOS%(RECNO%)
  229.     
  230.      FOR D% = 1 TO RECNO%
  231.  
  232.           GET #1, D%
  233.  
  234.           GDNOS%(D%) = CVI(RCNO$)
  235.          
  236.           IF GDNOS%(D%) > 0 THEN PTR1% = PTR1% + 1
  237.   
  238.      NEXT
  239.  
  240.      REDIM SRT1%(PTR1%): PTR1% = 0
  241.  
  242. '    LOAD ACTIVE RECORDS
  243.  
  244.      FOR D% = 1 TO RECNO%
  245.        
  246.           GET #1, D%: Z% = CVI(RCNO$)
  247.          
  248.           IF Z% > 0 THEN PTR1% = PTR1% + 1: SRT1%(PTR1%) = Z%
  249.   
  250.      NEXT
  251.  
  252.     CLOSE #1: GOSUB 430
  253.  
  254. '   DETECT INDEXING
  255.  
  256.     INDXSW% = 0: IXCTR% = 0: D% = 0
  257.  
  258.     WHILE IXCTR% < 5 AND D% < SEGNO%
  259.  
  260.      D% = D% + 1
  261.  
  262.      IF K%(D%, 1) = 1 AND K%(D%, 3) > 0 THEN
  263.   
  264.           INDXSW% = 1: IXCTR% = IXCTR% + 1
  265.           IXSGTS%(IXCTR%) = D%
  266.  
  267.      END IF
  268.  
  269.      WEND
  270.  
  271. '    LOAD INDEX FILE, IF ANY
  272.   
  273.      IF INDXSW% = 1 THEN
  274.  
  275.           REDIM IX%(5, RECNO%)
  276.         
  277.           GOSUB 4412: LOCATE 23, 31: PRINT "LOADING FILE INDEX";
  278.  
  279.           GOSUB 420
  280.  
  281.           A$ = PTH$ + "\FILEINDX.RAD"
  282.  
  283.           OPEN "R", #5, A$, 10
  284.  
  285.           FIELD #5, 2 AS IXBUFR$(1), 2 AS IXBUFR$(2), 2 AS IXBUFR$(3), 2 AS IXBUFR$(4), 2 AS IXBUFR$(5)
  286.  
  287.           FOR D% = 1 TO RECNO%
  288.  
  289.                GET #5, D%
  290.  
  291.                FOR M% = 1 TO 5
  292.        
  293.                IX%(M%, D%) = CVI(IXBUFR$(M%))
  294.   
  295.                NEXT
  296.  
  297.           NEXT
  298.  
  299.           CLOSE #5
  300.   
  301.      END IF
  302.  
  303. '    LOAD CODE HISTORY
  304.  
  305.      CU% = 0
  306.   
  307.      A$ = PTH$ + "\CODESUSD.HTY"
  308.   
  309.      ON ERROR GOTO 435
  310.   
  311.      OPEN A$ FOR INPUT AS #1: GOSUB 420
  312.  
  313.      WHILE NOT EOF(1)
  314.  
  315.          INPUT #1, I$
  316.  
  317.          IF EOF(1) AND I$ = "" THEN GOTO 310
  318.  
  319.          T$ = MID$(I$, 1, 1): X% = ASC(T$)
  320.          CODES%(X% - 32) = 1: CU% = CU% + 1
  321.          X$ = MID$(I$, 3, LEN(I$))
  322.  
  323.          IF LEN(X$) > 60 THEN X$ = MID$(X$, 1, 60)
  324.  
  325.          CU$(X% - 32) = X$
  326.  
  327. 310  WEND
  328.  
  329.      CLOSE #1: GOSUB 430
  330.  
  331.      IF CU% = 73 THEN
  332.  
  333.           GOSUB 4412: CR1$ = "ALL CODES USED,": CR2$ = "PERFORM RESTART"
  334.           PTL% = 23: GOSUB 4470: BEEP: GOSUB DELAY: GOTO 410
  335.  
  336.      END IF
  337.  
  338. 320 RETURN
  339.  
  340. MASS.LABELS:
  341.  
  342.      IF CRSW% < 4 AND DUP.SW% = 1 THEN
  343.                                                                                                   
  344.           PMPT$(0) = "PRINT LABELS FOR RECORDS CONTAINING CODE: " + CODE$ + "?"
  345.           PMPT$(1) = "1=YES"
  346.           PMPT$(2) = "2=BYPASS DUPLICATES"
  347.  
  348.           DUP.SW% = GET.CHOICE(2, PMPT$())
  349.  
  350.      ELSE DUP.SW% = 0
  351.     
  352.      END IF
  353.     
  354.      GOSUB ALIGN.LABELS
  355.     
  356.      GOSUB 4412: LOCATE 23, 10
  357.      PRINT "LABELS TO PRINT:"; SRNO%;
  358.     
  359.      IF DUP.SW% > 0 THEN PRINT TAB(37); "DUPLICATES:";
  360.  
  361.      PRINT TAB(58); "PRINTED:";
  362.  
  363.      X% = 0: Y% = 0
  364.    
  365.      FOR D% = 1 TO SRNO%
  366.   
  367.           GOSUB 420: GET #4, SRT1%(D%): GOSUB 425
  368.   
  369.           WFG% = 0
  370.          
  371.           IF DUP.SW% AND CRSW% < 4 THEN
  372.  
  373.                Z% = 9
  374.               
  375.                WHILE Z% < 12 AND WFG% = 0
  376.                    
  377.                     M% = FN.GET.CURR(Z%)
  378.                    
  379.                     A$ = BUFR$(1, M%)
  380.                     WFG% = INSTR(A$, CODE$)
  381.                     Z% = Z% + 1
  382.  
  383.                WEND
  384.  
  385.           END IF
  386.          
  387.           IF WFG% = 0 OR DUP.SW% = 1 THEN
  388.          
  389.                GOSUB SCREEN.LABEL
  390.                GOSUB PRINT.LABEL
  391.               
  392.                X% = X% + 1
  393.                LOCATE 23, 66: PRINT X%;
  394.  
  395.           ELSE
  396.  
  397.           Y% = Y% + 1
  398.           LOCATE 23, 48: PRINT Y%;
  399.          
  400.           END IF
  401.     
  402.      NEXT
  403.  
  404.      GOSUB 430
  405.     
  406.      GOSUB 4402: LOCATE 13, 28
  407.      PRINT "PRESS ANY KEY TO CONTINUE";
  408.      GOSUB 7600
  409.     
  410.      RETURN
  411.  
  412. 405 RESUME 409
  413.  
  414. 409 COLOR 7, 0, 0: CLS : END
  415.  
  416. DELAY:
  417.    
  418.      T$ = MID$(TIME$, 7, 2)
  419.      T% = VAL(T$)
  420.      T% = T% + 4
  421.     
  422.      IF T% > 59 THEN T% = T% - 60
  423.  
  424.      WHILE TT% <> T%
  425.     
  426.           T$ = MID$(TIME$, 7, 2)
  427.           TT% = VAL(T$)
  428.    
  429.      WEND
  430.  
  431.      RETURN
  432.  
  433. 420 ON ERROR GOTO 4000: RETURN
  434.  
  435. 425 ON ERROR GOTO 4010: RETURN
  436.  
  437. 430 ON ERROR GOTO 0: RETURN
  438.  
  439. 435 RESUME 320
  440.  
  441. 440 X% = 0: RESUME 4750
  442.  
  443. PRINT.CODES:
  444.  
  445.      GOSUB 4412: LOCATE 23, 10
  446.      PRINT "MAKE THE PRINTER READY,  AND PRESS ANY KEY TO BEGIN LISTING.";
  447.      GOSUB 7600
  448.   
  449.      GOSUB 4412: LOCATE 23, 29
  450.      PRINT "PRODUCING  CODE SHEETS";
  451.     
  452.      GOSUB 425: SRSW% = 0
  453.  
  454.      WHILE SRSW% < 2
  455.    
  456.           FOR D% = 1 TO 3: LPRINT : NEXT:
  457.           LPRINT STRING$(79, "*"): LPRINT : LPRINT
  458.   
  459.           CR1$ = "MAILOUT REPORT:": CR2$ = "LISTING OF CODES "
  460.   
  461.           IF SRSW% = 0 THEN CR2$ = CR2$ + "USED" ELSE CR2$ = CR2$ + "AVAILABLE"
  462.   
  463.           PTL% = 0: GOSUB 4470: LPRINT TAB(CNTR%); CR$: LPRINT : LPRINT
  464.   
  465.           CR1$ = "DATAFILE IS: ": CR2$ = PTH$: PTL% = 0: GOSUB 4470
  466.           LPRINT TAB(CNTR%); CR$; : LPRINT : LPRINT
  467.   
  468.           LPRINT STRING$(79, "*"): LPRINT : LPRINT : LNCTR% = 15
  469.  
  470.           FOR D% = 1 TO 94
  471.                  
  472.                A% = D% + 32
  473.   
  474.                IF A% = 34 THEN GOTO SKIP.CODE
  475.   
  476.                IF SRSW% = 0 AND CODES%(D%) = 0 THEN GOTO SKIP.CODE
  477.   
  478.                IF SRSW% = 1 AND CODES%(D%) = 1 THEN GOTO SKIP.CODE
  479.                  
  480.                LPRINT "CODE: "; CHR$(A%); TAB(10); "USE: "; CU$(D%)
  481.                LPRINT STRING$(79, "|"): LNCTR% = LNCTR% + 2
  482.   
  483.                IF LNCTR% > 59 THEN
  484.         
  485.                     LPRINT CHR$(12);
  486.              
  487.                     FOR LNCTR% = 1 TO 4: LPRINT : NEXT
  488.  
  489.                END IF
  490.  
  491. SKIP.CODE:
  492.         
  493.           NEXT
  494.  
  495.           LPRINT CHR$(12); : SRSW% = SRSW% + 1
  496.   
  497.      WEND
  498.    
  499.      SRSW% = 0: GOSUB 430
  500.   
  501.      RETURN
  502.  
  503. ALIGN.LABELS:
  504.  
  505.      GOSUB 4402: ALIGN% = 0
  506.  
  507.      LOCATE 13, 10
  508.      PRINT "MOUNT THE LABELS IN YOUR PRINTER, ALIGN THE LABELS PROPERLY.";
  509.    
  510.      GOSUB 4412: LOCATE 23, 27
  511.      PRINT "PRESS ANY KEY  WHEN READY:"; : GOSUB 7600
  512.  
  513.      WHILE ALIGN% = 0
  514.     
  515.           GOSUB 425
  516.           FOR D% = 1 TO 6: LPRINT "XXXXXXXXXXXXXXXXXXXXX": NEXT
  517.           LPRINT : LPRINT : LPRINT
  518.    
  519.           FOR D% = 1 TO 9: LPRINT : NEXT
  520.    
  521.           PMPT$(0) = "PRINT ANOTHER ALIGNMENT LABEL?"
  522.           PMPT$(1) = "1=YES"
  523.           PMPT$(2) = "2=GENERATE LABELS:"
  524.  
  525.           I = GET.CHOICE(2, PMPT$())
  526.    
  527.           IF I = 2 THEN ALIGN% = 1
  528.     
  529.      WEND
  530.  
  531.      RETURN
  532.  
  533. SCREEN.LABEL:
  534.    
  535.      GOSUB 4402: LOCATE 9, 28
  536.  
  537.      IF CRSW% < 4 THEN
  538.   
  539.           PRINT STRING$(29, " "); STR$(GDNOS%(SRT1%(D%))); CODE$
  540.   
  541.      END IF
  542.  
  543.      M% = FN.GET.CURR(2)
  544.     
  545.      LOCATE , 28
  546.      IF BUFR$(1, M%) <> SPACE$(25) THEN PRINT BUFR$(1, M%)
  547.  
  548.      M% = FN.GET.CURR(3)
  549.    
  550.      LOCATE , 28
  551.      IF BUFR$(1, M%) <> SPACE$(20) THEN PRINT BUFR$(1, M%)
  552.  
  553.      M% = FN.GET.CURR(1)
  554.    
  555.      LOCATE , 28
  556.      IF BUFR$(1, M%) <> SPACE$(35) THEN PRINT BUFR$(1, M%)
  557.  
  558.      M% = FN.GET.CURR(4)
  559.    
  560.      LOCATE , 28
  561.      PRINT BUFR$(1, M%)
  562.  
  563.      M% = FN.GET.CURR(5)
  564.    
  565.      LOCATE , 28
  566.      PRINT RTRIM$(BUFR$(1, M%));
  567.     
  568.      M% = FN.GET.CURR(6)
  569.   
  570.      PRINT ", "; BUFR$(1, M%);
  571.     
  572.      M% = FN.GET.CURR(7)
  573.   
  574.      PRINT ". "; BUFR$(1, M%)
  575.   
  576.      RETURN
  577.  
  578. PRINT.LABEL:
  579.    
  580.      LNCTR% = 1: GOSUB 425
  581.     
  582.      LABELS.DONE% = LABELS.DONE% + 1
  583.   
  584.      IF CRSW% < 4 THEN
  585.   
  586.           LPRINT STRING$(29, " "); STR$(GDNOS%(SRT1%(D%))); CODE$
  587.           LNCTR% = LNCTR% + 1
  588.   
  589.      END IF
  590.  
  591.      M% = FN.GET.CURR(2)
  592.    
  593.      IF BUFR$(1, M%) <> SPACE$(25) THEN LPRINT BUFR$(1, M%): LNCTR% = LNCTR% + 1
  594.  
  595.      M% = FN.GET.CURR(3)
  596.    
  597.      IF BUFR$(1, M%) <> SPACE$(20) THEN LPRINT BUFR$(1, M%): LNCTR% = LNCTR% + 1
  598.  
  599.      M% = FN.GET.CURR(1)
  600.    
  601.      IF BUFR$(1, M%) <> SPACE$(35) THEN LPRINT BUFR$(1, M%): LNCTR% = LNCTR% + 1
  602.  
  603.      M% = FN.GET.CURR(4)
  604.    
  605.      LPRINT BUFR$(1, M%): LNCTR% = LNCTR% + 1
  606.  
  607.      M% = FN.GET.CURR(5)
  608.   
  609.      LPRINT RTRIM$(BUFR$(1, M%));
  610.     
  611.      M% = FN.GET.CURR(6)
  612.   
  613.      LPRINT ", "; BUFR$(1, M%);
  614.     
  615.      M% = FN.GET.CURR(7)
  616.   
  617.      LPRINT ". "; BUFR$(1, M%)
  618.     
  619.      LNCTR% = LNCTR% + 1
  620.   
  621.      FOR S% = LNCTR% TO 9: LPRINT : NEXT
  622.   
  623. '    WRITE CODE IN RECORD
  624.     
  625.      IF CRSW% < 3 THEN
  626.   
  627.           Y% = 9: I$ = SPACE$(35)
  628.  
  629.           WHILE (LEN(I$) = 35 AND Y% < 11)
  630.        
  631.                M% = FN.GET.CURR(Y%)
  632.               
  633.                I$ = RTRIM$(BUFR$(1, M%))
  634.  
  635.                Y% = Y% + 1
  636.  
  637.           WEND
  638.   
  639.           IF LEN(I$) THEN I$ = I$ + CODE$ ELSE I$ = CODE$
  640.   
  641.           LSET BUFR$(1, M%) = I$: GOSUB 420
  642.           PUT #4, SRT1%(D%)
  643.   
  644.      END IF
  645.  
  646.      GOSUB 430
  647.     
  648.      RETURN
  649.  
  650. '    FIND AND MAKE MENU OF DATAMAGE FILES
  651.  
  652. 3400 IF MAX% = 1 AND FTOT%(1) > 0 THEN GOTO 3452
  653.     
  654.      X% = 1: GOSUB 4412
  655.     
  656.      IF MAX% = 1 THEN
  657.     
  658.      CR1$ = "READING DIRECTORY OF:": CR2$ = PTH$
  659.      PTL% = 23: GOSUB 4470: GOTO 3410
  660.  
  661.      END IF
  662.  
  663.      LOCATE 23, 30: PRINT "LOADING MARKER FILES";
  664.  
  665. 3410
  666.      X$ = PTH$ + "\DIRFILE"
  667.      SH$ = "DIR " + PTH$ + ">" + X$
  668.     
  669.      GOSUB 8100
  670.     
  671.      ON ERROR GOTO 3750: OPEN X$ FOR INPUT AS #1: GOSUB 430
  672.     
  673.      WHILE NOT EOF(1)
  674.     
  675.      LINE INPUT #1, I$
  676.     
  677.      IF I$ = "" OR EOF(1) THEN GOTO 3450
  678.     
  679.      T$ = MID$(I$, 1, 1)
  680.     
  681.      IF T$ = " " OR T$ = "." THEN GOTO 3450
  682.     
  683.      B$ = RTRIM$(MID$(I$, 1, 8))
  684.      A$ = PTH$ + "\" + B$
  685.     
  686.      SELECT CASE MAX%
  687.     
  688.      CASE 1:
  689.     
  690.           T$ = "DIR"
  691.          
  692.           IF MID$(I$, 15, 3) = T$ THEN A$ = A$ + "\CITYNAME.SAD" ELSE GOTO 3450
  693.  
  694.           'BREAK
  695.  
  696.      CASE 2:
  697.     
  698.           T$ = "MKR"
  699.          
  700.           IF MID$(I$, 10, 3) = T$ THEN A$ = A$ + ".MKR" ELSE GOTO 3450
  701.  
  702.           'BREAK
  703.     
  704.      END SELECT
  705.  
  706. 3441 B$ = B$ + "." + T$: TT$ = ""
  707.     
  708.      ON ERROR GOTO 3443: OPEN A$ FOR INPUT AS #2
  709.     
  710.      INPUT #2, TT$: GOTO 3444
  711.  
  712. 3443 RESUME 3450
  713.  
  714. 3444 CLOSE #2
  715.  
  716.      IF LEN(TT$) <> 35 THEN GOTO 3450
  717.     
  718.      IF FTOT%(MAXX%) > 49 THEN GOTO 3450
  719.     
  720.      FTOT%(MAX%) = FTOT%(MAX%) + 1
  721.      FILE$(MAX%, 1, FTOT%(MAX%)) = B$
  722.      FILE$(MAX%, 2, FTOT%(MAX%)) = TT$
  723.  
  724. 3450 WEND
  725.     
  726.      CLOSE #1: KILL X$: GOSUB 430
  727.  
  728.      IF SRSW% = 1 THEN SRSW% = 0: GOTO 3745
  729.  
  730. 3452 IF FTOT%(MAX%) = 0 THEN
  731.     
  732.           CR1$ = "SORRY, NO ": CR2$ = "FILES FOUND."
  733.           GOSUB 4412: BEEP: PTL% = 23: GOSUB 4470
  734.           GOSUB DELAY: EXT$ = "FAILED": GOTO 3745
  735.  
  736.      END IF
  737.  
  738.      GOSUB 4402: LOCATE 4, 15
  739.      PRINT "FILENAME"; TAB(38); "USER-ASSIGNED DESCRIPTION";
  740.    
  741.      COLOR 6: LOCATE 5, 9
  742.      PRINT CHR$(201); STRING$(62, CHR$(205)); CHR$(187);
  743.    
  744.      FOR D1% = 6 TO 19
  745.      LOCATE D1%, 9: PRINT CHR$(186);
  746.      LOCATE D1%, 72: PRINT CHR$(186);
  747.      NEXT
  748.  
  749.      LOCATE 20, 9: PRINT CHR$(200); STRING$(62, CHR$(205)); CHR$(188);
  750.      COLOR MC%: FT% = 1: FL% = 0: F% = FTOT%(MAX%)
  751.  
  752. 3500 GOSUB 4408
  753.  
  754.      FOR FL% = 0 TO 13
  755.      M% = FT% + FL%
  756.      IF M% > F% THEN GOTO 3510
  757.   
  758.      LOCATE FL% + 6, 13: PRINT FILE$(MAX%, 1, M%);
  759.      LOCATE , 33: PRINT FILE$(MAX%, 2, M%);
  760.  
  761. 3510 NEXT: FL% = FL% - 1
  762.  
  763.      IF FL% > F% - 1 THEN FL% = F% - 1
  764.  
  765. 3515 GOSUB 4412: COLOR 6: LOCATE 23, 12
  766.      PRINT "MOVEMENT KEYS: "; CHR$(24); CHR$(25);
  767.      PRINT " PgDn PgUp Home End Esc RET = SELECT FILE";
  768.  
  769. 3525 COLOR 25: LOCATE FL% + 6, 13
  770.      PRINT FILE$(MAX%, 1, FT% + FL%); : COLOR MC%
  771.    
  772.      IF SRSW% = 1 THEN
  773.     
  774.      SRSW% = 0: LOCATE , 33: PRINT FILE$(MAX%, 2, FT% + FL%);
  775.  
  776.      END IF
  777.    
  778.      GOSUB 7600: LOCATE FL% + 6, 13
  779.      PRINT FILE$(MAX%, 1, FT% + FL%); : COLOR MC%
  780.  
  781.      IF LEN(I$) = 2 THEN GOTO 3650
  782.  
  783. 3570 M% = ASC(I$)
  784.  
  785.      IF M% = 13 THEN EXT$ = FILE$(MAX%, 1, FT% + FL%): GOTO 3745
  786.  
  787.      IF M% = 27 THEN EXT$ = "FAILED": GOTO 3745
  788.  
  789.      BEEP: GOTO 3525
  790.  
  791. 3650 T$ = MID$(I$, 2, 1): X% = ASC(T$)
  792.  
  793.      SELECT CASE X%
  794.   
  795.      CASE 71: GOTO 3500'  HOME
  796.   
  797.      CASE 79:  'END
  798.         FT% = F% - 13
  799.      
  800.         IF FT% < 1 THEN FT% = 1
  801.      
  802.         GOTO 3500
  803.   
  804.      CASE 81:  '   PAGE DOWN
  805.         FT% = FT% + 14: IF FT% > (F% - 14) THEN FT% = F% - 13
  806.      
  807.         IF FT% < 1 THEN FT% = 1
  808.      
  809.         GOTO 3500
  810.   
  811.      CASE 73:  '  PAGE UP
  812.         FT% = FT% - 14
  813.      
  814.         IF FT% < 1 THEN FT% = 1
  815.      
  816.         GOTO 3500
  817.   
  818.      CASE 80:   '  LINE DOWN
  819.   
  820.         IF FT% + FL% >= F% THEN BEEP: GOTO 3525
  821.   
  822.         IF FL% < 13 THEN FL% = FL% + 1: GOTO 3525
  823.   
  824.         FT% = FT% + 1: GOSUB 4437: SRSW% = 1: GOTO 3525
  825.   
  826.      CASE 72:  '  LINE UP
  827.   
  828.         IF FL% = 0 AND FT% = 1 THEN BEEP: GOTO 3525
  829.   
  830.         IF FL% > 0 THEN FL% = FL% - 1: GOTO 3525
  831.   
  832.         FT% = FT% - 1
  833.   
  834.         IF FT% = 0 THEN FTSW% = 1: BEEP: GOTO 3525
  835.   
  836.         GOSUB 4447: SRSW% = 1: GOTO 3525
  837.   
  838.      CASE ELSE: BEEP: GOTO 3525
  839.  
  840.      END SELECT
  841.  
  842. 3745 CLOSE #2: RETURN
  843.  
  844. 3750 EXT$ = "FAILED": RESUME 3745
  845.  
  846. '    DISK ERROR ROUTINE
  847.  
  848. 4000 PMPT$(0) = "DISK"
  849.      GOTO 4015
  850.  
  851. '    PRINTER ERROR ROUTINE
  852.  
  853. 4010 GOSUB 4412: BEEP: LOCATE 23, 18
  854.      PMPT$(0) = "PRINTER"
  855.  
  856. 4015 PMPT$(0) = PMPT$(0) + " ERROR:"
  857.      PMPT$(1) = "1=RETRY"
  858.      PMPT$(2) = "2=ABORT PROGRAM"
  859.     
  860.      BEEP: I = GET.CHOICE(2, PMPT$())
  861.     
  862.      IF I = 1 THEN RESUME
  863.     
  864.      RESUME 410
  865.  
  866. '    CALLS TO BIOS TO HANDLE SCREEN VIA WW.OBJ LINKED IN
  867.  
  868. 4402 CALL WW(ATTR%, 19, 78, 1, 1, 0, 7): RETURN
  869.  
  870. 4408 CALL WW(ATTR%, 18, 70, 5, 9, 0, 7): RETURN
  871.  
  872. 4412 CALL WW(ATTR%, 23, 78, 21, 1, 0, 7): RETURN
  873.  
  874. 4420 CALL WW(ATTR%, 0, 0, 32, 0, 0, 1): RETURN
  875.  
  876. 4437 CALL WW(ATTR%, 18, 70, 5, 9, 1, 6): RETURN
  877.  
  878. 4447 CALL WW(ATTR%, 18, 70, 5, 9, 1, 7): RETURN
  879.  
  880. 4465 'LINE INPUT; X$:RETURN
  881.      X$ = SPACE$(MAX%): CALL MINPUT(CPTY%, X%, MAX%, ISRSW%, MISW%, ATTR%, CTRL$, PASS$, X$): COLOR MC%, 0: RETURN
  882.     
  883. 4470 CALL CNTRSTRP(PTL%, CNTR%, CR1$, CR2$, TT1$, TT2$, CR$): RETURN
  884.  
  885. 4510 GOSUB 4412: LOCATE 23, 6
  886.      PRINT "SEARCHING"; (SCTR%); "INDEX(S)"; TAB(32); "TO SEARCH:"; RECNO%; TAB(53); "RECORDS SEARCHED:";
  887.      RETURN
  888.  
  889. '    KEYBOARD WAIT (PRESS ANY KEY)
  890.  
  891. 7600 I$ = "": WHILE I$ = "": I$ = INKEY$: WEND: RETURN
  892.  
  893. '    CALL INPUT ROUTINE
  894.  
  895. 8000 'LINE INPUT; X$:RETURN
  896.  
  897.      CALL INPT(MAX%, MC%, SEEDSW%, CTRL$, X$): RETURN
  898.  
  899. '    GET COMMAND.COM SERVICES
  900.  
  901. 8100 A# = FRE(""): LOCATE 1, 1: SHELL SH$
  902.  
  903. DRAW.BORDER:
  904.   
  905.    LOCATE 1, 1: COLOR 3
  906.    PRINT CHR$(201); STRING$(29, CHR$(205)); "[";
  907.   
  908.    COLOR 12: PRINT " D A T A  M A G E "; :
  909.    COLOR 3: PRINT "]"; STRING$(29, CHR$(205)); CHR$(187);
  910.   
  911.    FOR D% = 2 TO 24
  912.    LOCATE D%, 1: PRINT CHR$(186); : LOCATE D%, 80: PRINT CHR$(186);
  913.    NEXT
  914.  
  915.    LOCATE 21, 1
  916.    PRINT CHR$(204); STRING$(78, CHR$(205)); CHR$(185);
  917.  
  918.    LOCATE 25, 1
  919.    PRINT CHR$(200); STRING$(28, CHR$(205)); "[";
  920.    COLOR 11: PRINT " SALES MAIL MANAGER ";
  921.    COLOR 3: PRINT "]"; STRING$(28, CHR$(205)); CHR$(188);
  922.   
  923.    COLOR MC%
  924.  
  925.    RETURN
  926.  
  927. DESPACER:
  928.    
  929.      IS$ = ""
  930.    
  931.      FOR M% = 1 TO LEN(TT1$)
  932.    
  933.      C$ = MID$(TT1$, M%, 1): IF C$ = " " THEN GOTO 7660
  934.      IS$ = IS$ + C$
  935.  
  936. 7660 NEXT: RETURN
  937.  
  938. GET.CODE:
  939.  
  940.      GOSUB 4402: LOCATE 5, 34: PRINT "CODEING MENU"
  941.   
  942.      LOCATE 8, 16: PRINT "1.  LIST USED AND AVAILABLE CODES TO THE PRINTER"
  943.      LOCATE 11, 16: PRINT "2.  WRITE CODE ON LABELS, RECORD IN THE DATABASE"
  944.      LOCATE 14, 16: PRINT "3.  WRITE CODE ON LABELS, DO NOT RECORD THE CODE"
  945.      LOCATE 17, 16: PRINT "4.  BYPASS  ALL  CODEING OF THIS LABEL  PRINTOUT"
  946.   
  947.      PMPT$(0) = "CODE OPTION:"
  948.      PMPT$(1) = "1=PRINT"
  949.      PMPT$(2) = "2=WRITE & RECORD"
  950.      PMPT$(3) = "3=WRITE ONLY"
  951.      PMPT$(4) = "4=BYPASS"
  952.     
  953.      CRSW% = GET.CHOICE(4, PMPT$())
  954.   
  955.      IF CRSW% = 4 OR CRSW% = 1 THEN GOTO 1000
  956.  
  957. 945  GOSUB 4412: LOCATE 23, 15
  958.      PRINT "PRESS A ONE LETTER CODE TO REPRESENT THIS MAILOUT:";
  959.    
  960.      GOSUB 7600: X% = ASC(I$)
  961.   
  962.      IF X% < 32 OR X% > 126 OR X% = 34 THEN
  963.   
  964.           BEEP: GOSUB 4412: LOCATE 23, 27
  965.           PRINT "INVALID ENTRY,  TRY AGAIN."; : GOSUB DELAY: GOTO 945
  966.             
  967.      END IF
  968.   
  969.      CODE$ = I$: DUP.SW% = 0
  970.  
  971.      IF CODES%(X% - 32) = 1 THEN
  972.   
  973.           DUP.SW% = 1
  974.          
  975.           BEEP: GOSUB 4402
  976.           LOCATE 11, 28: PRINT "THIS CODE  HAS BEEN USED";
  977.           
  978.           CR1$ = "PURPOSE WAS:"
  979.           CR2$ = CU$(X% - 32)
  980.           PTL% = 13: GOSUB 4470
  981.  
  982.           PMPT$(0) = "USE THIS CODE?"
  983.           PMPT$(1) = "1=YES"
  984.           PMPT$(2) = "2=NO"
  985.          
  986.           I = GET.CHOICE(2, PMPT$())
  987.          
  988.           IF I = 2 THEN GOTO 945
  989.   
  990.      END IF
  991.   
  992.      IF CRSW% = 3 THEN GOTO 1000
  993.     
  994.      IF DUP.SW% = 0 THEN
  995.     
  996.           GOSUB 4412: LOCATE 23, 10
  997.           PRINT "ENTER  DESCRIPTION: ";
  998.  
  999.           CTRL$ = "S": MAX% = 40: GOSUB 8000
  1000.           NC$ = CODE$ + " " + X$
  1001.  
  1002.      END IF
  1003.   
  1004. 1000 GOSUB 4402: CR1$ = "YOUR CHOICE WAS: "
  1005.    
  1006.      SELECT CASE CRSW%
  1007.    
  1008.      CASE 1: CR2$ = "LIST CODES TO THE PRINTER"
  1009.      CASE 2: CR2$ = "WRITE CODE AND RECORD IT IN THE DATABASE"
  1010.      CASE 3: CR2$ = "WRITE CODE, BUT DO NOT RECORD"
  1011.      CASE 4: CR2$ = "BYPASS THE CODEING OPERATIONS"
  1012.  
  1013.      END SELECT
  1014.  
  1015. 1025 PTL% = 13: GOSUB 4470
  1016.    
  1017.      IF LEN(CODE$) THEN
  1018.    
  1019.      CR1$ = "CODE ENTERED IS: ": CR2$ = CODE$: PTL% = 16: GOSUB 4470
  1020.    
  1021.      END IF
  1022.    
  1023.      PMPT$(0) = "YOU MAY:"
  1024.      PMPT$(1) = "1=CONTINUE"
  1025.      PMPT$(2) = "2=RE-ENTER CHOICE"
  1026.  
  1027.      I = GET.CHOICE(2, PMPT$())
  1028.    
  1029.      IF I = 2 THEN BEEP: GOTO GET.CODE
  1030.    
  1031.      IF CRSW% = 1 THEN GOSUB PRINT.CODES: GOTO GET.CODE
  1032.   
  1033.      IF CRSW% = 2 AND DUP.SW% = 0 THEN
  1034.    
  1035.           A$ = PTH$ + "\CODESUSD.HTY": GOSUB 420
  1036.    
  1037.           OPEN A$ FOR APPEND AS #1
  1038.           PRINT #1, CHR$(34) + NC$ + CHR$(34)
  1039.           CLOSE #1: GOSUB 430
  1040.  
  1041.      END IF
  1042.    
  1043.      RETURN
  1044.  
  1045. MAIN.MENU:
  1046.  
  1047.      WHILE RUNNING% = 0
  1048.    
  1049.           CLOSE : FTOT%(1) = 0: PTH$ = ORG.PTH$
  1050.    
  1051.           GOSUB 4402: LOCATE 8, 15
  1052.           PRINT "1.  PRINT LABELS FOR ALL RECORDS IN SOURCE DATAFILE";
  1053.         
  1054.           LOCATE 10, 15
  1055.           PRINT "2.  PRINT LABELS FOR THE RECORDS IN  A  MARKER FILE";
  1056.    
  1057.           LOCATE 12, 15
  1058.           PRINT "3.  PRINT LABELS FOR RECORDS FOUND VIA INDEX SEARCH";
  1059.  
  1060.           LOCATE 14, 15
  1061.           PRINT "4.  ENTER DATA FOR THE LABEL(S)  FROM  THE KEYBOARD";
  1062.  
  1063.           LOCATE 16, 15
  1064.           PRINT "5.  EXIT THE POWER MAIL PROGRAM AND RUN THE GO PGRM";
  1065.  
  1066.           PMPT$(0) = "MAKE LABELS FOR:"
  1067.           PMPT$(1) = "1=ALL RECORDS"
  1068.           PMPT$(2) = "2=MARKER FILE"
  1069.           PMPT$(3) = "3=SEARCH"
  1070.           PMPT$(4) = "4=KEYBOARD"
  1071.           PMPT$(5) = "3=EXIT"
  1072.          
  1073.           MKR% = GET.CHOICE(5, PMPT$())
  1074.          
  1075.           SELECT CASE MKR%
  1076.   
  1077.           CASE 1:
  1078.   
  1079.                GOSUB LOAD.FILE
  1080.         
  1081.                SRNO% = 0
  1082.               
  1083.                FOR D% = 1 TO RECNO%
  1084.    
  1085.                IF GDNOS%(D%) THEN SRNO% = SRNO% + 1: SRT1%(SRNO%) = D%
  1086.  
  1087.                NEXT
  1088.  
  1089.                GOSUB GET.CODE
  1090.    
  1091.                GOSUB MASS.LABELS
  1092.   
  1093.           CASE 2:
  1094.    
  1095.                GOSUB LOAD.FILE
  1096.         
  1097.                MAX% = 2: GOSUB 3400
  1098.  
  1099.                IF EXT$ = "FAILED" THEN BEEP: GOTO MAIN.MENU
  1100.  
  1101.                A$ = PTH$ + "\" + EXT$
  1102.               
  1103.                GOSUB 4412: LOCATE 23, 30
  1104.                PRINT "LOADING  MARKER FILE";
  1105.  
  1106.                GOSUB 420: OPEN A$ FOR BINARY AS #2
  1107.    
  1108.                O$ = SPACE$(37): GET #2, , O$
  1109.  
  1110.                B$ = SPACE$(40): GET #2, , B$
  1111.    
  1112.                Z% = CVI(MID$(B$, 1, 2))
  1113.                CSW% = CVI(MID$(B$, 3, 2))
  1114.    
  1115.                O$ = SPACE$(48): GET #2, , O$
  1116.  
  1117.                T% = 2
  1118.  
  1119.                IF CSW% THEN
  1120.  
  1121.                     IF CSW% = 3 THEN T% = T% + 16 ELSE T% = T% + 8
  1122.  
  1123.                END IF
  1124.  
  1125.                O$ = SPACE$(T%): A% = 0
  1126.    
  1127.                FOR D% = 1 TO Z%
  1128.    
  1129.                     GET #2, , O$
  1130.         
  1131.                     SRT1%(A%) = CVI(MID$(O$, 1, 2))
  1132.         
  1133.                     IF SRT1%(A%) THEN A% = A% + 1
  1134.         
  1135.                NEXT
  1136.  
  1137.                CLOSE #2: GOSUB 430
  1138.               
  1139.                IF A% = 0 THEN
  1140.   
  1141.                     GOSUB 4412: LOCATE 23, 25
  1142.                     PRINT "LOADING OF MARKER FILE  FAILED";
  1143.                    
  1144.                     BEEP: GOSUB DELAY: RESET: GOTO MAIN.MENU
  1145.   
  1146.                END IF
  1147.              
  1148.                SRNO% = A%
  1149.         
  1150.                CLOSE #1: GOSUB 430
  1151.  
  1152.                GOSUB GET.CODE
  1153.         
  1154.                GOSUB MASS.LABELS
  1155.         
  1156.           CASE 3:
  1157.  
  1158.                GOSUB LOAD.FILE
  1159.        
  1160.                GOSUB GET.CODE
  1161.        
  1162.                GOSUB ALIGN.LABELS
  1163.               
  1164.                WFG4% = 1: CR% = 0
  1165.              
  1166.   
  1167.                WHILE WFG4% = 1
  1168.  
  1169. 4650           IF INDXSW% = 0 THEN
  1170.        
  1171.                     I = 1
  1172.   
  1173.                ELSE
  1174.   
  1175.                     PMPT$(0) = "TARGET OF SEARCH:"
  1176.                     PMPT$(1) = "1=RECORD NUMBERS"
  1177.                     PMPT$(2) = "2=FILE INDEXES"
  1178.                     PMPT$(3) = "3=QUIT"
  1179.   
  1180.                     I = GET.CHOICE(3, PMPT$())
  1181.  
  1182.                END IF
  1183.   
  1184.                SELECT CASE I
  1185.  
  1186.                CASE 1:
  1187.  
  1188. 4700                GOSUB 4412: LOCATE 23, 6
  1189.                     PRINT "ENTER THE NUMBER OF THE RECORD TO BE ACCESSED, OR 0 TO ABORT:  ";
  1190.                     CTRL$ = "N": MAX% = 5: GOSUB 8000: A = VAL(X$)
  1191.  
  1192.                     IF A = 0 THEN
  1193.        
  1194.                          IF INDXSW% = 0 THEN WFG4% = 0
  1195.             
  1196.                          GOTO 4799
  1197.  
  1198.                     END IF
  1199.        
  1200.                     IF A < 1 OR A > 32727 OR INT(A) < A THEN
  1201.  
  1202.                          CR1$ = "ILLEGAL RECORD NUMBER:"
  1203.                          CR2$ = STR$(A): PTL% = 23
  1204.       
  1205.                          BEEP: GOSUB 4412: GOSUB 4470
  1206.                          GOSUB DELAY: GOTO 4700
  1207.  
  1208.                     END IF
  1209.  
  1210.                     GOSUB 4412: LOCATE 23, 28: PRINT "CHECKING RECORD NUMBERS...";
  1211.  
  1212.                     M% = 0: GPNO% = 0
  1213.  
  1214.                     WHILE GPNO% = 0 AND M% < PTR1%
  1215.  
  1216.                          M% = M% + 1
  1217.                          IF GDNOS%(SRT1%(M%)) = A THEN GPNO% = M%
  1218.  
  1219.                     WEND
  1220.  
  1221.                     IF GPNO% = 0 THEN
  1222.  
  1223.                          GOSUB 4412: BEEP
  1224.                          CR1$ = "RECORD NUMBER:"
  1225.                          CR2$ = STR$(A) + "  WAS NOT FOUND!"
  1226.                          CR% = 0: PTL% = 23: GOSUB 4470
  1227.                          GOSUB DELAY: GOTO 4700
  1228.  
  1229.                     END IF
  1230.  
  1231.                     D% = GPNO%
  1232.  
  1233.                     GOSUB 420: GET #4, SRT1%(D%)
  1234.  
  1235.                     ' DETECT DUPLICATE
  1236.                        
  1237.                     Z% = 9: WFG8% = 0
  1238.             
  1239.                     WHILE Z% < 12 AND WFG8% = 0
  1240.                  
  1241.                          A$ = BUFR$(1, Z%)
  1242.                          WFG8% = INSTR(A$, CODE$)
  1243.                          Z% = Z% + 1
  1244.  
  1245.                     WEND
  1246.                        
  1247.                     IF WFG8% > 0 AND CRSW% < 4 THEN
  1248.  
  1249.                          GOSUB 4412: BEEP: LOCATE 23, 19
  1250.                          PRINT "THE RECORD FOUND ALREADY CONTAINS CODE: "; CODE$;
  1251.                          GOSUB DELAY
  1252.  
  1253.                     END IF
  1254.                    
  1255.                     GOSUB SCREEN.LABEL
  1256.  
  1257.                     PMPT$(0) = "PRINT THIS LABEL?"
  1258.                     PMPT$(1) = "1=YES"
  1259.                     PMPT$(2) = "2=NO"
  1260.            
  1261.                     I = GET.CHOICE(2, PMPT$())
  1262.  
  1263.                     IF I = 1 THEN
  1264.                    
  1265.                          GOSUB PRINT.LABEL
  1266.  
  1267.                     END IF
  1268.  
  1269.                CASE 2:
  1270.   
  1271.                     FOR D% = 1 TO 5: ETY$(D%) = "": NEXT
  1272.  
  1273. 4740                GOSUB 4402: WFG% = 0: SCTR% = 0
  1274.  
  1275.                     FOR Z% = 1 TO IXCTR%
  1276.  
  1277.                          X% = IXSGTS%(Z%): PASS$ = ETY$(Z%)
  1278.                          T$ = "ENTER: " + HDG$(X%): COLOR 25:
  1279.                          LOCATE ((Z% - 1) * 3) + 5, 4: PRINT T$; TAB(40);
  1280.                          CTRL$ = "S": MAX% = K%(X%, 2)
  1281.                          MISW% = 1: GOSUB 4465
  1282.  
  1283.                          TT$ = SPACE$(LEN(T$)): LSET TT$ = HDG$(X%)
  1284.                          LOCATE ((Z% - 1) * 3) + 5, 4: PRINT TT$;
  1285.  
  1286.                          IF LEN(X$) = 0 THEN ETY$(Z%) = "": GOTO 4745
  1287.  
  1288.                          SCTR% = SCTR% + 1: ETY$(Z%) = X$
  1289.                          SC%(SCTR%, 1) = Z%: SC%(SCTR%, 2) = X%
  1290.  
  1291.                          TT1$ = X$
  1292.   
  1293.                          '  INDEX FIELD
  1294.  
  1295.                          X% = -32768: CALL DECODER(X$, IS$)
  1296.  
  1297.                          FOR B% = 1 TO LEN(IS$)
  1298.   
  1299.                               T$ = MID$(IS$, B%, 1)
  1300.                               Y% = ASC(T$)
  1301.                               M% = (Y% MOD B%)
  1302.                  
  1303.                               ON ERROR GOTO 440
  1304.                  
  1305. 4750                          IF M% = 0 THEN
  1306.                  
  1307.                                    X% = X% + Y%
  1308.                  
  1309.                               ELSE X% = X% + (Y% + B%) * M%
  1310.                  
  1311.                               END IF
  1312.  
  1313.                               GOSUB 430
  1314.  
  1315.                          NEXT
  1316.  
  1317.                          SC%(SCTR%, 4) = X%
  1318.  
  1319.                          PMPT$(0) = "SEARCH MODE:"
  1320.                          PMPT$(1) = "1=IGNORE CASE/SPACING"
  1321.                          PMPT$(2) = "2=STRICT EQUALITY"
  1322.             
  1323.                          SC%(SCTR%, 3) = GET.CHOICE(2, PMPT$())
  1324.  
  1325.                          IF SC%(SCTR%, 3) = 2 THEN TT1$ = X$: GOSUB DESPACER
  1326.                          CXTRY$(1, SCTR%) = IS$
  1327.  
  1328. 4745                NEXT
  1329.  
  1330.                     IF SCTR% = 0 THEN BEEP: GOTO 4799
  1331.  
  1332.                     GOSUB 4510: WFG2% = 0: D% = 0
  1333.  
  1334.                     WHILE D% < PTR1% AND WFG2% = 0
  1335.             
  1336.                          D% = D% + 1: CR% = D%
  1337.                          LOCATE , 70: PRINT D%;
  1338.  
  1339.                          WFG% = 0
  1340.  
  1341.                          FOR C% = 1 TO SCTR%
  1342.       
  1343.                               IDX% = SC%(C%, 4)
  1344.                  
  1345.                               IF SRSW% = 0 THEN G% = SRT1%(D%) ELSE G% = Z%
  1346.                  
  1347.                               IF IX%(SC%(C%, 1), G%) = IDX% THEN P% = C%: WFG% = WFG% + 1
  1348.  
  1349.                          NEXT
  1350.  
  1351.                          IF WFG% < SCTR% THEN WFG% = 1: GOTO 4757
  1352.  
  1353.                          FOR C% = 1 TO SCTR%
  1354.   
  1355.                               GOSUB 420: GET #4, G%: GOSUB 430
  1356.   
  1357.                               TT1$ = BUFR$(1, SC%(C%, 2))
  1358.                  
  1359.                               IF SC%(C%, 3) = 1 THEN
  1360.                  
  1361.                                    CALL DECODER(TT1$, IS$)
  1362.                  
  1363.                               ELSE GOSUB DESPACER
  1364.                  
  1365.                               END IF
  1366.  
  1367.                               CXTRY$(2, C%) = IS$
  1368.   
  1369.                          NEXT
  1370.  
  1371.                          WFG% = 0
  1372.   
  1373.                          FOR C% = 1 TO SCTR%
  1374.        
  1375.                               IF CXTRY$(1, C%) = CXTRY$(2, C%) THEN WFG% = WFG% + 1
  1376.   
  1377.                          NEXT
  1378.  
  1379.                          IF WFG% < SCTR% THEN WFG% = 1 ELSE WFG% = 0
  1380.  
  1381. 4757                     IF WFG% = 1 THEN GOTO 4770
  1382.  
  1383.                          GOSUB 420: GET #4, SRT1%(D%)
  1384.             
  1385.                          GOSUB SCREEN.LABEL
  1386.  
  1387.                          ' DETECT DUPLICATE
  1388.                         
  1389.                          Z% = 9: WFG8% = 0
  1390.              
  1391.                          WHILE Z% < 12 AND WFG8% = 0
  1392.                   
  1393.                               A$ = BUFR$(1, Z%)
  1394.                               WFG8% = INSTR(A$, CODE$)
  1395.                               Z% = Z% + 1
  1396.  
  1397.                          WEND
  1398.                         
  1399.                          IF WFG8% AND CRSW% < 4 THEN
  1400.  
  1401.                               GOSUB 4412: BEEP: LOCATE 23, 19
  1402.                               PRINT "THE RECORD FOUND ALREADY CONTAINS CODE: "; CODE$;
  1403.                               GOSUB DELAY
  1404.  
  1405.                          END IF
  1406.                         
  1407.                          PMPT$(0) = "YOU MAY:"
  1408.                          PMPT$(1) = "1=PRINT AND QUIT"
  1409.                          PMPT$(2) = "2=CONTINUE SEARCH"
  1410.                          PMPT$(3) = "3=PRINT AND CONTINUE"
  1411.                          PMPT$(4) = "4=ABORT"
  1412.             
  1413.                          I = GET.CHOICE(4, PMPT$())
  1414.   
  1415.                          SELECT CASE I
  1416.  
  1417.                          CASE 1:
  1418.                               GOSUB PRINT.LABEL
  1419.                               WFG2% = 1
  1420.  
  1421.                          CASE 2:
  1422.  
  1423.                          CASE 3:
  1424.                               GOSUB PRINT.LABEL
  1425.  
  1426.                          CASE 4:
  1427.                               WFG2% = 1
  1428.  
  1429.                          END SELECT
  1430.  
  1431.  
  1432. 4770                WEND
  1433.  
  1434.                     IF WFG2% = 1 THEN GOTO 4799
  1435.  
  1436.                     PMPT$(0) = "END OF SEARCH:"
  1437.                     PMPT$(1) = "1=RETRY"
  1438.                     PMPT$(2) = "2=ABORT"
  1439.  
  1440.                     I = GET.CHOICE(2, PMPT$())
  1441.  
  1442.                     IF I = 1 THEN GOTO 4740
  1443.   
  1444.                     CR% = 0: WFG4% = 0
  1445.  
  1446.                     'BREAK
  1447.   
  1448.                CASE 3: WFG4% = 0
  1449.   
  1450.                END SELECT
  1451.  
  1452. 4799           WFG% = 0: WFG1% = 0: WFG2% = 0
  1453.  
  1454.                WEND
  1455.  
  1456.           CASE 4:
  1457.          
  1458.                GOSUB ALIGN.LABELS
  1459.               
  1460.                GOSUB 430
  1461.               
  1462.                RESTORE 200: ETG% = 0
  1463.               
  1464.                FOR SEGNO% = 1 TO 7
  1465.          
  1466.                     READ K%(SEGNO%, 1), K%(SEGNO%, 2), K%(SEGNO%, 3)
  1467.                     K%(SEGNO%, 4) = SEGNO%
  1468.  
  1469.                NEXT
  1470.               
  1471.                HDG$(1) = "COMPANY NAME"
  1472.                HDG$(2) = "CONTACT"
  1473.                HDG$(3) = "TITLE"
  1474.                HDG$(4) = "STREET ADDRESS"
  1475.                HDG$(5) = "CITY"
  1476.                HDG$(6) = "STATE"
  1477.                HDG$(7) = "ZIP"
  1478.               
  1479.                RESTORE 200
  1480.               
  1481.                WHILE ETG% = 0
  1482.               
  1483.                     GOSUB 4402
  1484.                    
  1485.                     FOR X% = 1 TO 7
  1486.  
  1487.                          T$ = "ENTER: " + HDG$(X%): COLOR 25:
  1488.                          LOCATE ((X% - 1) * 2) + 5, 4: PRINT T$; TAB(40);
  1489.                         
  1490.                          CTRL$ = "S": MAX% = K%(X%, 3)
  1491.                          MISW% = 1: GOSUB 4465
  1492.  
  1493.                          TT$ = SPACE$(LEN(T$)): LSET TT$ = HDG$(X%)
  1494.                          LOCATE ((X% - 1) * 2) + 5, 4: PRINT TT$;
  1495.  
  1496.                          BUFR$(1, X%) = X$
  1497.  
  1498.                     NEXT
  1499.               
  1500.                     CRSW% = 5: GOSUB SCREEN.LABEL
  1501.  
  1502.                     PMPT$(0) = "PRINT THIS LABEL?"
  1503.                     PMPT$(1) = "1=YES"
  1504.                     PMPT$(2) = "2=NO"
  1505.                    
  1506.                     I = GET.CHOICE(2, PMPT$())
  1507.  
  1508.                     IF I = 1 THEN
  1509.  
  1510.                     GOSUB 4412
  1511.                    
  1512.                     A$ = STR$(LABELS.DONE%)
  1513.                     CR1$ = MID$(A$, 2)
  1514.                     CR2$ = "LABELS HAVE BEEN PRINTED"
  1515.                     PTL% = 23: GOSUB 4470
  1516.                    
  1517.                     GOSUB DELAY
  1518.                    
  1519.                     GOSUB 4412: LOCATE 23, 18
  1520.                     PRINT "ENTER NUMBER OF THIS LABEL TO PRINT:  ";
  1521.                     CTRL$ = "N": MAX% = 5: GOSUB 8000
  1522.                    
  1523.                     X = VAL(X$)
  1524.                    
  1525.                     GOSUB 4412: LOCATE 23, 10
  1526.                     PRINT "LABELS TO PRINT:  "; X; TAB(48); "LABELS PRINTED:";
  1527.  
  1528.                     FOR Y = 1 TO X
  1529.                    
  1530.                          GOSUB PRINT.LABEL
  1531.                         
  1532.                          LOCATE 23, 64: PRINT Y
  1533.  
  1534.                     NEXT
  1535.  
  1536.                     END IF
  1537.                    
  1538.                     PMPT$(0) = "ENTER ANOTHER LABEL?"
  1539.                     PMPT$(1) = "1=YES"
  1540.                     PMPT$(2) = "2=NO"
  1541.                   
  1542.                     I = GET.CHOICE(2, PMPT$())
  1543.                    
  1544.                     IF I = 2 THEN ETG% = 1
  1545.  
  1546.                WEND
  1547.  
  1548.           CASE 5: RUNNING% = 1
  1549.    
  1550.           END SELECT
  1551.  
  1552.      CLOSE
  1553.    
  1554.      WEND
  1555.   
  1556. 410 GOSUB 4402: GOSUB 4412: ON ERROR GOTO 405
  1557.     RESET: CHAIN "GO"
  1558.  
  1559.