home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Basic / Samples / DBFM2 / DBFM2.ZIP / MAILLIST.BAS < prev    next >
Encoding:
BASIC Source File  |  1994-02-07  |  31.6 KB  |  939 lines
  1. DECLARE SUB QuitFunctions (xk%)
  2. DECLARE SUB BrowseRecords (krs%, ky$, rec$, status%)
  3. DECLARE SUB RecordFunctions (xk%)
  4. DECLARE SUB PrintFunctions (xk%)
  5. DECLARE SUB MiscFunctions (xk%)
  6. DECLARE SUB FileFunctions (xk%)
  7. DECLARE SUB Display (rec$)
  8. DECLARE SUB Help ()
  9. DECLARE SUB FindRecord (krs%, ky$, rec$, status%)
  10. DECLARE SUB AddRecord (krs%, ky$, rec$, status%)
  11. DECLARE SUB DeleteRecord (krs%, ky$, rec$, status%)
  12. DECLARE SUB ChangeRecord (krs%, ky$, rec$, status%)
  13. DECLARE SUB PrintML1 (rec$)
  14. DECLARE SUB PrintML0 ()
  15. DECLARE SUB PrintML9 ()
  16. DECLARE SUB PrintML2 (rec$)
  17. DECLARE SUB ReIndexFile ()
  18. DECLARE SUB CloseFiles ()
  19. DECLARE SUB OpenFiles ()
  20. ' IMDEMO.BAS   by  Marty Francom
  21. ' This program is demonstrates the use of Index Manager. Each index record
  22. ' consists of a key and a pointer to the data file. Such that the key file
  23. ' record (KyF$) is defined:
  24. '  ky$ = KeyString$   rn& = Pointer to data record   krs% = KeyRecordSet
  25. '  Rec$= DataRecord   Rfn%= data record file number  Rfl%= Data record Length
  26. '
  27. ' For the purpose of this demo I open only 1 index and data file however
  28. ' it is a simple matter to open additional index and data files.
  29. DECLARE FUNCTION ColorAttribute% (row%, col%)
  30. DECLARE FUNCTION CurToDollar$ (Cur@, L%)
  31. DECLARE FUNCTION DayOfWeek$ ()
  32. DECLARE FUNCTION FILEXISTS% (FILNAM$)
  33. DECLARE FUNCTION GetBackGround% (row%, col%)
  34. DECLARE FUNCTION GetForeGround% (row%, col%)
  35. DECLARE FUNCTION GetVideoSegment& ()
  36. DECLARE FUNCTION IntgrToDollar$ (Intgr&, L%)
  37. DECLARE FUNCTION KeyIn% ()
  38. DECLARE FUNCTION NumDays& (dt1$, dt2$)
  39. DECLARE FUNCTION NumToString$ (n#, dp%, Ln%)
  40. DECLARE SUB Cdate (dt$)
  41. DECLARE SUB DateEdit (row%, col%, colr%, vk$, dt$, xk%)
  42. DECLARE SUB FastPrint (row%, col%, st$, colr%)
  43. DECLARE SUB EditField (row%, col%, colr%, vk$, st$, xk%)
  44. DECLARE SUB Julian (dt$)
  45. DECLARE SUB PhoneEdit (row%, col%, colr%, vk$, pn$, xk%)
  46. DECLARE SUB PopWindow (TopRow%, LeftCol%, BottomRow%, RightCol%, colr%)
  47. DECLARE SUB PutScreen (file$)
  48. DECLARE SUB RestoreScrn (Scrn$)
  49. DECLARE SUB SaveScrn (Scrn$)
  50. DECLARE SUB Wipe (top%, bottom%, lft%, rght%, colr%)
  51.  
  52. DECLARE SUB AddKeyRec (krs%, ky$, rec$, rn&, status%)
  53. DECLARE SUB CreateOpenClose (krs%)
  54. DECLARE SUB DeleteKeyRec (krs%, ky$, rec$, status%)
  55. DECLARE SUB GetEqual (krs%, ky$, rec$, rn&, status%)
  56. DECLARE SUB GetNext (krs%, ky$, rec$, status%)
  57. DECLARE SUB GetPrev (krs%, ky$, rec$, status%)
  58. DECLARE SUB IndexError (rc%)
  59. DECLARE SUB Info (krs%, xn%, kl%, Rfn%, Rfl%)
  60. '
  61. ' Link in the Index Manager subprogram
  62. DECLARE SUB im (ndx%, opcode$, ndxfn$, keylen%, ky$, datarn&, rc%)
  63. $LINK "IMOB.OBJ"                 ' this must be in main program
  64. $LINK "C:\PB3\UNIT\MYLIB.PBU"    '  "    "   "  "   "      "
  65. ' IMOB.OBJ is an assembly language B-Tree index manager for PowerBasic. As
  66. 'many as 10 index files can be opened, manipulated and maintained all at the
  67. 'same time. IMOB.OBJ is copyright of FRED LEPOW of CDP Consultants. Several
  68. 'versions of IMOB.OBJ are available. For further Information about Index
  69. 'Manager contact Fred Lepow at:
  70. '                     CDP Consultants
  71. '                     1700 Circo Del Cielo Drive
  72. '                     El Cajon, CA.   90202
  73. '                     (619) 440-6482
  74.  
  75. '           Required for Index Manager
  76. DIM xn as shared integer
  77. DIM kl as shared integer
  78. DIM Rfn as shared integer
  79. DIM Rfl as shared integer
  80. DIM ky as shared string
  81. 'DIM Rec as shared string
  82. DIM status as shared integer
  83.  
  84. ' ******************* Beginning Main Program Code **********************
  85. CLS
  86. CALL PutScreen("MailList.Img")
  87. 'krs% = 3: CALL CreateOpenClose(krs%)  'contains pointers to deleted records
  88. krs% = 2: CALL CreateOpenClose(krs%)  'Zip+Name Index
  89. krs% = 1: CALL CreateOpenClose(krs%)  'Name Index + Data Record
  90. xk% = -20
  91. DO
  92.   LOCATE 1, 1, 0
  93.   IF xk% = 0 THEN CALL Display(rec$): xk% = KeyIn%
  94.   SELECT CASE xk%
  95.     CASE -59  'F1 key
  96.       CALL Help: xk% = 0
  97.     CASE 102, 70, -20, -18, -33, -25, -49, -48, -72, -80   'Ff
  98.       IF xk% = 102 OR xk% = 70 THEN CALL FileFunctions(xk%)
  99.       SELECT CASE (xk%)
  100.         CASE -18  'Alt E  goto end of file
  101.           ky$ = STRING$(kl%, 254)
  102.           CALL GetEqual(krs%, ky$, rec$, rn&, status%): xk% = 0
  103.         CASE -20  'Alt T  goto top of file
  104.           ky$ = STRING$(kl%, 32)
  105.           CALL GetEqual(krs%, ky$, rec$, rn&, status%): xk% = 0
  106.         CASE -33  'Alt F  Find a record
  107.           CALL FindRecord(krs%, ky$, rec$, status%): xk% = 0
  108.         CASE -48  'Alt B  browse records
  109.           CALL BrowseRecords(krs%, ky$, rec$, status%): xk% = 0
  110.         CASE -25, -72  'Alt P  UpArrow   get previous record
  111.           CALL GetPrev(krs%, ky$, rec$, status%): xk% = 0
  112.         CASE -49, -80  'Alt N  DnArrow   get next record
  113.           CALL GetNext(krs%, ky$, rec$, status%): xk% = 0
  114.       END SELECT
  115.     CASE 114, 82, -30, -32, -46
  116.       IF xk% = 114 OR xk% = 82 THEN CALL RecordFunctions(xk%)
  117.       SELECT CASE (xk%)
  118.         CASE -30  'Alt A  Add a record
  119.           CALL AddRecord(krs%, ky$, rec$, status%): xk% = 0
  120.           CALL PutScreen("MailList.IMG")
  121.         CASE -32  'Alt D  Delete current record
  122.           CALL DeleteRecord(krs%, ky$, rec$, status%): xk% = 0
  123.           CALL PutScreen("MailList.IMG")
  124.         CASE -46  'Alt C  Change/Edit current record
  125.           CALL ChangeRecord(krs%, ky$, rec$, status%): xk% = 0
  126.           CALL PutScreen("MailList.IMG")
  127.       END SELECT
  128.     CASE 112, 80, -120, -121, -122, -123
  129.       IF xk% = 112 OR xk% = 80 THEN CALL PrintFunctions(xk%)
  130.       SELECT CASE (xk%)
  131.         CASE -120  ' Alt 1  Print current record to mailing label
  132.           CALL PrintML1(rec$): xk% = 0
  133.         CASE -129  ' Alt 0  Print mailing labels of all records
  134.           CALL PrintML0: xk% = 0
  135.         CASE -121  ' Alt 2  Print mailing labels by zip code
  136.           CALL PrintML9: xk% = 0
  137.         CASE -128  ' Alt 9  Print hard copy of current record
  138.           CALL PrintML2(rec$): xk% = 0
  139.       END SELECT
  140.     CASE 109, 77
  141.        CALL MiscFunctions(xk%)
  142.        SELECT CASE (xk%)
  143.          CASE -10  ' ReIndex Current Data File
  144.            CALL ReIndexFile: xk% = 0
  145.          CASE -11  ' Create New Data File & Index
  146.            CALL CloseFiles: xk% = 0
  147.          CASE -12  ' Load New Data File & Index
  148.            CALL OpenFiles: xk% = 0
  149.        END SELECT
  150.     CASE 113, 81, -16, 27
  151.       CALL QuitFunctions(xk%)
  152.       IF xk% = -16 THEN
  153.         CALL CloseFiles: EXIT DO
  154.       END IF
  155.     CASE ELSE
  156.       BEEP: xk% = 0
  157.   END SELECT
  158. LOOP
  159. CLS : END
  160.  
  161. SUB AddRecord (krs%, ky$, rec$, status%)
  162.   st$ = "MailList.Img": CALL PutScreen(st$)
  163.   new$ = SPACE$(683): cn% = 1
  164.   DO
  165.     SELECT CASE cn%
  166.       CASE 1
  167.         st$ = MID$(new$, 2, 28)
  168.         xk% = 11: CALL EditField(6, 20, 79, "", st$, xk%)
  169.         MID$(new$, 2, 16) = st$
  170.       CASE 2
  171.         st$ = MID$(new$, 31, 30)
  172.         xk% = 11: CALL EditField(8, 20, 79, "", st$, xk%)
  173.         MID$(new$, 31, 30) = st$
  174.       CASE 3
  175.         st$ = MID$(new$, 61, 30)
  176.         xk% = 11: CALL EditField(10, 20, 79, "", st$, xk%)
  177.         MID$(new$, 61, 30) = st$
  178.       CASE 4
  179.         st$ = MID$(new$, 91, 14)
  180.         xk% = 11: CALL EditField(12, 20, 79, "", st$, xk%)
  181.         MID$(new$, 91, 14) = st$
  182.       CASE 5
  183.         st$ = MID$(new$, 105, 2)
  184.         xk% = 11: CALL EditField(12, 45, 79, "", st$, xk%)
  185.         MID$(new$, 105, 2) = st$
  186.       CASE 6
  187.         st$ = MID$(new$, 107, 5)
  188.         xk% = 2: CALL EditField(12, 58, 79, "", st$, xk%)
  189.         MID$(new$, 107, 5) = st$
  190.         st$ = MID$(new$, 112, 4)
  191.         xk% = 2: CALL EditField(12, 64, 79, "", st$, xk%)
  192.         MID$(new$, 112, 4) = st$
  193.       CASE 7
  194.         st$ = MID$(new$, 116, 3)
  195.         xk% = 2: CALL EditField(14, 21, 79, "", st$, xk%)
  196.         MID$(new$, 116, 3) = st$
  197.         st$ = MID$(new$, 119, 3)
  198.         xk% = 2: CALL EditField(14, 26, 79, "", st$, xk%)
  199.         MID$(new$, 119, 3) = st$
  200.         st$ = MID$(new$, 122, 4)
  201.         xk% = 2: CALL EditField(14, 30, 79, "", st$, xk%)
  202.         MID$(new$, 122, 4) = st$
  203.       CASE 8
  204.         st$ = MID$(new$, 126, 62)
  205.         xk% = 1: CALL EditField(16, 10, 79, "", st$, xk%)
  206.         MID$(new$, 126, 62) = st$
  207.       CASE 9
  208.         st$ = MID$(new$, 188, 62)
  209.         xk% = 1: CALL EditField(17, 10, 79, "", st$, xk%)
  210.         MID$(new$, 188, 62) = st$
  211.       CASE 10
  212.         st$ = MID$(new$, 250, 62)
  213.         xk% = 1: CALL EditField(18, 10, 79, "", st$, xk%)
  214.         MID$(new$, 250, 62) = st$
  215.       CASE 11
  216.         st$ = MID$(new$, 312, 62)
  217.         xk% = 1: CALL EditField(19, 10, 79, "", st$, xk%)
  218.         MID$(new$, 312, 62) = st$
  219.       CASE 12
  220.         st$ = MID$(new$, 374, 62)
  221.         xk% = 1: CALL EditField(20, 10, 79, "", st$, xk%)
  222.         MID$(new$, 374, 62) = st$
  223.       CASE 13
  224.         st$ = MID$(new$, 436, 62)
  225.         xk% = 1: CALL EditField(21, 10, 79, "", st$, xk%)
  226.         MID$(new$, 436, 62) = st$
  227.       CASE 14
  228.         st$ = MID$(new$, 498, 62)
  229.         xk% = 1: CALL EditField(22, 10, 79, "", st$, xk%)
  230.         MID$(new$, 498, 62) = st$
  231.       CASE 15
  232.         st$ = MID$(new$, 560, 62)
  233.         xk% = 1: CALL EditField(23, 10, 79, "", st$, xk%)
  234.         MID$(new$, 560, 62) = st$
  235.       CASE 16
  236.         st$ = MID$(new$, 622, 62)
  237.         xk% = 1: CALL EditField(24, 10, 79, "", st$, xk%)
  238.         MID$(new$, 622, 62) = st$
  239.     END SELECT
  240.     IF xk% = 27 THEN
  241.      CALL SaveScrn(Scrn$)
  242.      CALL PopWindow(3, 30, 5, 52, 78)
  243.      st$ = "Save Record? (Y/n)": CALL FastPrint(4, 31, st$, 78)
  244.      DO
  245.        xk% = 22: st$ = "Y": CALL EditField(4, 50, 79, "YyNn", st$, xk%)
  246.        IF (xk% = 13 AND st$ <> "Y") OR xk% = 27 THEN EXIT DO
  247.        IF xk% = 13 THEN
  248.          tb% = 32: rec$ = new$: ky$ = MID$(rec$, 2, 28) + CHR$(tb%)
  249.          DO
  250.            CALL AddKeyRec(krs%, ky$, rec$, rn&, status%)
  251.            IF status% = 109 THEN
  252.              IF tb% > 253 THEN EXIT SUB
  253.              tb% = tb% + 1:  ky$ = MID$(rec$, 2, 28) + CHR$(tb%)
  254.            END IF
  255.          LOOP UNTIL status% = 0
  256.          krs1% = krs%
  257.          ky2$ = MID$(rec$, 107, 5) + ky$
  258.          krs% = krs1% + 1: CALL AddKeyRec(krs%, ky2$, "", rn&, status%)
  259.          CALL CreateOpenClose(krs%)
  260.          krs% = krs1%: CALL CreateOpenClose(krs%)
  261.        END IF
  262.      LOOP UNTIL status% = 0
  263.      CALL RestoreScrn(Scrn$)
  264.      EXIT SUB
  265.     END IF
  266.     IF xk% = -72 AND cn% > 1 THEN cn% = cn% - 1
  267.     IF (xk% = -80 OR xk% = 13) AND cn% < 16 THEN cn% = cn% + 1
  268.   LOOP
  269. END SUB
  270.  
  271. SUB BrowseRecords (krs%, ky$, rec$, status%)
  272.   CALL SaveScrn(Scrn$)
  273.   CALL PopWindow(8, 7, 23, 73, 78)
  274.   st$ = " Press  Up/Dn  PgUp/PgDn  to Move Thru File ": CALL FastPrint(23, 13, st$, 78)
  275.   DO
  276.     GOSUB BrowseDisplay
  277.     LOCATE 23, 26, 0: xk% = KeyIn%
  278.     IF xk% = -72 THEN
  279.       CALL GetPrev(krs%, ky$, rec$, status%)
  280.       IF status% <> 0 THEN CALL IndexError(status%)
  281.     END IF
  282.     IF xk% = -80 THEN
  283.       CALL GetNext(krs%, ky$, rec$, status%)
  284.       IF status% <> 0 THEN CALL IndexError(status%)
  285.     END IF
  286.     IF xk% = -73 THEN
  287.       FOR c% = 1 TO 14
  288.         CALL GetPrev(krs%, ky$, rec$, status%)
  289.       NEXT
  290.     END IF
  291.     IF xk% = -81 THEN
  292.       FOR c% = 1 TO 14
  293.         CALL GetNext(krs%, ky$, rec$, status%)
  294.       NEXT
  295.     END IF
  296.   LOOP UNTIL xk% = 27
  297.   ky$ = bky$: rec$ = ""
  298.   CALL GetEqual(krs%, ky$, rec$, rn&, status%)
  299.   CALL RestoreScrn(Scrn$)
  300.   EXIT SUB
  301.  
  302. BrowseDisplay:
  303.   bky$ = MID$(rec$, 2, 29)
  304.   FOR b% = 9 TO 22
  305.     st$ = MID$(rec$, 2, 28) + MID$(rec$, 91, 14)
  306.     st$ = st$ + " " + MID$(rec$, 107, 5) + " (" + MID$(rec$, 116, 3) + ") "
  307.     st$ = st$ + MID$(rec$, 119, 3) + "-" + MID$(rec$, 122, 4)
  308.     CALL FastPrint(b%, 9, st$, -1)
  309.     CALL GetNext(krs%, ky$, rec$, status%)
  310.     IF status% = 116 THEN rec$ = SPACE$(683)
  311.   NEXT b%
  312.   CALL GetEqual(krs%, bky$, rec$, rn&, status%)
  313.  RETURN
  314. END SUB
  315.  
  316. SUB ChangeRecord (krs%, ky$, rec$, status%)
  317.   cn% = 2:
  318.   CALL GetEqual(krs%, ky$, new$, rn&, status%)
  319.   IF status% <> 0 THEN EXIT SUB
  320.   DO
  321.     SELECT CASE cn%
  322.       'CASE 1
  323.       '  st$ = MID$(new$, 2, 28)
  324.       '  xk% = 12: CALL EditField(6, 20, 79, "", st$, xk%)
  325.       '  MID$(new$, 2, 16) = st$
  326.       CASE 2
  327.         st$ = MID$(new$, 31, 30)
  328.         xk% = 11: CALL EditField(8, 20, 79, "", st$, xk%)
  329.         MID$(new$, 31, 30) = st$
  330.       CASE 3
  331.         st$ = MID$(new$, 61, 30)
  332.         xk% = 11: CALL EditField(10, 20, 79, "", st$, xk%)
  333.         MID$(new$, 61, 30) = st$
  334.       CASE 4
  335.         st$ = MID$(new$, 91, 14)
  336.         xk% = 11: CALL EditField(12, 20, 79, "", st$, xk%)
  337.         MID$(new$, 91, 14) = st$
  338.       CASE 5
  339.         st$ = MID$(new$, 105, 2)
  340.         xk% = 11: CALL EditField(12, 45, 79, "", st$, xk%)
  341.         MID$(new$, 105, 2) = st$
  342.       CASE 6
  343.         st$ = MID$(new$, 107, 5)
  344.         xk% = 2: CALL EditField(12, 58, 79, "", st$, xk%)
  345.         MID$(new$, 107, 5) = st$
  346.         st$ = MID$(new$, 112, 4)
  347.         xk% = 2: CALL EditField(12, 64, 79, "", st$, xk%)
  348.         MID$(new$, 112, 4) = st$
  349.       CASE 7
  350.         st$ = MID$(new$, 116, 3)
  351.         xk% = 2: CALL EditField(14, 21, 79, "", st$, xk%)
  352.         MID$(new$, 116, 3) = st$
  353.         st$ = MID$(new$, 119, 3)
  354.         xk% = 2: CALL EditField(14, 26, 79, "", st$, xk%)
  355.         MID$(new$, 119, 3) = st$
  356.         st$ = MID$(new$, 122, 4)
  357.         xk% = 2: CALL EditField(14, 30, 79, "", st$, xk%)
  358.         MID$(new$, 122, 4) = st$
  359.       CASE 8
  360.         st$ = MID$(new$, 126, 62)
  361.         xk% = 1: CALL EditField(16, 10, 79, "", st$, xk%)
  362.         MID$(new$, 126, 62) = st$
  363.       CASE 9
  364.         st$ = MID$(new$, 188, 62)
  365.         xk% = 1: CALL EditField(17, 10, 79, "", st$, xk%)
  366.         MID$(new$, 188, 62) = st$
  367.       CASE 10
  368.         st$ = MID$(new$, 250, 62)
  369.         xk% = 1: CALL EditField(18, 10, 79, "", st$, xk%)
  370.         MID$(new$, 250, 62) = st$
  371.       CASE 11
  372.         st$ = MID$(new$, 312, 62)
  373.         xk% = 1: CALL EditField(19, 10, 79, "", st$, xk%)
  374.         MID$(new$, 312, 62) = st$
  375.       CASE 12
  376.         st$ = MID$(new$, 374, 62)
  377.         xk% = 1: CALL EditField(20, 10, 79, "", st$, xk%)
  378.         MID$(new$, 374, 62) = st$
  379.       CASE 13
  380.         st$ = MID$(new$, 436, 62)
  381.         xk% = 1: CALL EditField(21, 10, 79, "", st$, xk%)
  382.         MID$(new$, 436, 62) = st$
  383.       CASE 14
  384.         st$ = MID$(new$, 498, 62)
  385.         xk% = 1: CALL EditField(22, 10, 79, "", st$, xk%)
  386.         MID$(new$, 498, 62) = st$
  387.       CASE 15
  388.         st$ = MID$(new$, 560, 62)
  389.         xk% = 1: CALL EditField(23, 10, 79, "", st$, xk%)
  390.         MID$(new$, 560, 62) = st$
  391.       CASE 16
  392.         st$ = MID$(new$, 622, 62)
  393.         xk% = 1: CALL EditField(24, 10, 79, "", st$, xk%)
  394.         MID$(new$, 622, 62) = st$
  395.     END SELECT
  396.     IF xk% = 27 THEN
  397.      CALL PopWindow(3, 30, 5, 55, 78)
  398.      st$ = "Save Changes? (Y/n)": CALL FastPrint(4, 32, st$, 78)
  399.      DO
  400.        xk% = 22: st$ = "Y": CALL EditField(4, 53, 79, "YyNn", st$, xk%)
  401.        IF (xk% = 13 AND st$ <> "Y") OR xk% = 27 THEN EXIT DO
  402.        IF xk% = 13 THEN
  403.          CALL Info(krs%, xn%, kl%, Rfn%, Rfl%)
  404.          IF LEN(new$) < Rfl% THEN new$ = new$ + SPACE$(Rfl% - LEN(new$))
  405.          PUT #Rfn%, rn&, new$: rec$ = new$: EXIT DO
  406.        END IF
  407.      LOOP
  408.      EXIT SUB
  409.     END IF
  410.     IF xk% = -72 AND cn% > 2 THEN cn% = cn% - 2
  411.     IF (xk% = -80 OR xk% = 13) AND cn% < 12 THEN cn% = cn% + 1
  412.   LOOP
  413.  
  414. END SUB
  415.  
  416. SUB CloseFiles
  417.  'krs% = -3: CreateOpenClose (krs%)  'Not being used
  418.  krs% = -2: CreateOpenClose (krs%)
  419.  krs% = -1: CreateOpenClose (krs%)
  420. END SUB
  421.  
  422. SUB CreateOpenClose (krs%) 'public
  423.   IF krs% > 100 AND krs% < 105 THEN GOSUB CreateFile: EXIT SUB
  424.   IF krs% > 0 AND krs% < 5 THEN GOSUB OpenFile: EXIT SUB
  425.   IF krs% < 0 AND krs% > -5 THEN GOSUB CloseFile: EXIT SUB
  426.   EXIT SUB
  427.  
  428.   ' Close key-record files (if open)
  429. CloseFile:
  430.   ' get information about key-record-set (krs%)
  431.   krs% = ABS(krs%)
  432.   CALL Info(krs%, xn%, kl%, Rfn%, Rfl%)
  433.   fc$ = "C": CALL im(xn%, fc$, ifn$, kl%, ky$, rn&, rc%)
  434.   IF rc% <> 0 THEN CALL IndexError(rc%)
  435.   CLOSE Rfn%
  436.   xn% = 0: kl% = 0: Rfn% = 0: Rfl% = 0
  437.   ' store information about key-record-set (krs%)
  438.   S% = -1 * krs%: CALL Info(S%, xn%, kl%, Rfn%, Rfl%)
  439.  RETURN
  440.  
  441.   ' Open key-record file (if not already open)
  442. OpenFile:
  443.   ' get information about key-record-set (krs%)
  444.   CALL Info(krs%, xn%, kl%, Rfn%, Rfl%)
  445.   ' If key/data records open close first then re-open
  446.   IF xn% <> 0 THEN GOSUB CloseFile
  447.   IF krs% = 1 THEN xn% = 1: ifn$ = "ML1.ndx": kl% = 29: df$ = "ML1.Dat": Rfl% = 683
  448.   IF krs% = 2 THEN xn% = 2: ifn$ = "ML2.ndx": kl% = 34: df$ = "": Rfl% = 0
  449.   IF krs% = 3 THEN xn% = 3: ifn$ = "ML3.ndx": kl% = 7: df$ = "": Rfl% = 0
  450.   fc$ = "O": CALL im(xn%, fc$, ifn$, kl%, ky$, rn&, rc%)
  451.   IF rc% <> 0 THEN krs% = krs% + 100: GOTO CreateFile
  452.   IF df$ <> "" THEN Rfn% = FREEFILE: OPEN df$ FOR RANDOM AS #Rfn% LEN = Rfl%
  453.   ' store information about key-record-set (krs%)
  454.   S% = -1 * krs%: CALL Info(S%, xn%, kl%, Rfn%, Rfl%)
  455.  RETURN
  456.  
  457. CreateFile:
  458.   ' Initialize key-record file (if not already open)
  459.   ' If df$="" then create only a index file
  460.   CALL SaveScrn(Scrn$)
  461.   CALL PopWindow(5, 23, 9, 67, 78)
  462.   st$ = "Initializing File Will Delete": CALL FastPrint(5, 25, st$, -1)
  463.   st$ = "All Data In The File": CALL FastPrint(6, 25, st$, -1)
  464.   st$ = "ESC to Abort...CR to Continue": CALL FastPrint(7, 25, st$, -1)
  465.   DO
  466.     t% = KeyIn%
  467.     IF t% = 27 THEN CALL RestoreScrn(Scrn$): RETURN
  468.     IF t% = 13 THEN CALL RestoreScrn(Scrn$): EXIT DO
  469.   LOOP
  470.   krs% = krs% - 100
  471.   ' get information about key-record-set (krs%)
  472.   CALL Info(krs%, xn%, kl%, Rfn%, Rfl%)
  473.   IF xn% = 0 THEN
  474.     IF krs% = 1 THEN xn% = 1: ifn$ = "ML1.ndx": kl% = 29: df$ = "ML1.Dat": Rfl% = 683
  475.     IF krs% = 2 THEN xn% = 2: ifn$ = "ML2.ndx": kl% = 34: df$ = "": Rfl% = 0
  476.     IF krs% = 3 THEN xn% = 3: ifn$ = "ML3.ndx": kl% = 7: df$ = "": Rfl% = 0
  477.     Rfn% = FREEFILE
  478.     IF df$ <> "" THEN OPEN df$ FOR BINARY AS Rfn%: CLOSE Rfn%: KILL df$
  479.     IF ifn$ <> "" THEN OPEN ifn$ FOR BINARY AS Rfn%: CLOSE Rfn%: KILL ifn$
  480.     fc$ = "I": CALL im(xn%, fc$, ifn$, kl%, ky$, rn&, rc%)
  481.     fc$ = "C": CALL im(xn%, fc$, ifn$, kl%, ky$, rn&, rc%)
  482.     fc$ = "O": CALL im(xn%, fc$, ifn$, kl%, ky$, rn&, rc%)
  483.     IF rc% <> 0 THEN CALL IndexError(rc%)
  484.     Rfn% = FREEFILE
  485.     IF df$ <> "" THEN OPEN df$ FOR RANDOM AS #Rfn% LEN = Rfl%
  486.     ' store information about key-record-set (krs%)
  487.     S% = -1 * krs%: CALL Info(S%, xn%, kl%, Rfn%, Rfl%)
  488.   ELSE
  489.     rc% = 112: CALL IndexError(rc%)
  490.   END IF
  491.  RETURN
  492.  
  493. END SUB
  494.  
  495. SUB DeleteRecord (krs%, ky$, rec$, status%)
  496.   CALL PopWindow(3, 20, 5, 60, 78)
  497.   st$ = "Delete Current Record? (y/N)"
  498.   CALL FastPrint(4, 22, st$, 78)
  499.   DO
  500.     xk% = 22: st$ = "N": CALL EditField(4, 51, 79, "YyNn", st$, xk%)
  501.     IF xk% = 13 AND st$ = "Y" THEN
  502.       'CALL GetEqual(krs%, ky$, rec$, rn&, status%)
  503.       'ky3$ = "ML1" + MKL$(rn&)
  504.       'krs% = 3: CALL AddRecord(krs$, ky3$, "", rn&, status)
  505.       ky2$ = MID$(rec$, 107, 5) + MID$(rec$, 2, 29)
  506.       krs% = 2: CALL DeleteKeyRec(krs%, ky2$, "", status%)
  507.       CALL CreateOpenClose(krs%)
  508.       krs% = 1: CALL DeleteKeyRec(krs%, ky$, rec$, status%)
  509.       CALL CreateOpenClose(krs%)
  510.       CALL GetPrev(krs%, ky$, rec$, status%)
  511.     END IF
  512.   LOOP UNTIL xk% = 27 OR xk% = 13
  513. END SUB
  514.  
  515. SUB Display (rec$)
  516.   IF LEN(rec$) < 683 THEN rec$ = SPACE$(683)
  517.   st$ = MID$(rec$, 2, 28): CALL FastPrint(6, 20, st$, -1)
  518.   'st$ = MID$(rec$, 30, 1): CALL FastPrint(6, 67, st$, -1) 'tie breaker
  519.   st$ = MID$(rec$, 31, 30): CALL FastPrint(8, 20, st$, -1)
  520.   st$ = MID$(rec$, 61, 30): CALL FastPrint(10, 20, st$, -1)
  521.   st$ = MID$(rec$, 91, 14): CALL FastPrint(12, 20, st$, -1)
  522.   st$ = MID$(rec$, 105, 2): CALL FastPrint(12, 45, st$, -1)
  523.   st$ = MID$(rec$, 107, 5): CALL FastPrint(12, 58, st$, -1)
  524.   st$ = MID$(rec$, 112, 4): CALL FastPrint(12, 64, st$, -1)
  525.   st$ = MID$(rec$, 116, 3): CALL FastPrint(14, 21, st$, -1)
  526.   st$ = MID$(rec$, 119, 3): CALL FastPrint(14, 26, st$, -1)
  527.   st$ = MID$(rec$, 122, 4): CALL FastPrint(14, 30, st$, -1)
  528.   st$ = MID$(rec$, 126, 62): CALL FastPrint(16, 10, st$, -1)
  529.   st$ = MID$(rec$, 188, 62): CALL FastPrint(17, 10, st$, -1)
  530.   st$ = MID$(rec$, 250, 62): CALL FastPrint(18, 10, st$, -1)
  531.   st$ = MID$(rec$, 312, 62): CALL FastPrint(19, 10, st$, -1)
  532.   st$ = MID$(rec$, 374, 62): CALL FastPrint(20, 10, st$, -1)
  533.   st$ = MID$(rec$, 436, 62): CALL FastPrint(21, 10, st$, -1)
  534.   st$ = MID$(rec$, 498, 62): CALL FastPrint(22, 10, st$, -1)
  535.   st$ = MID$(rec$, 560, 62): CALL FastPrint(23, 10, st$, -1)
  536.   st$ = MID$(rec$, 622, 62): CALL FastPrint(24, 10, st$, -1)
  537. END SUB
  538.  
  539. SUB FileFunctions (xk%)
  540.   CALL SaveScrn(Scrn$)
  541.   st$ = "FileFunctions": CALL FastPrint(1, 3, st$, 14)
  542.   CALL PopWindow(2, 3, 9, 31, 78)
  543.   c% = 1: xk% = 0: GOSUB DisplayFFchoice
  544.   DO
  545.     t% = KeyIn%
  546.     SELECT CASE t%
  547.        CASE -80  'up arrow
  548.          c% = c% + 1: IF c% > 6 THEN c% = 1
  549.          GOSUB DisplayFFchoice
  550.        CASE -72  'dn arrow
  551.          c% = c% - 1: IF c% < 1 THEN c% = 6
  552.          GOSUB DisplayFFchoice
  553.        CASE -18, -20, -33, -48, -25, -49
  554.          xk% = t%: EXIT DO
  555.        CASE 13
  556.          IF xk% <> 0 THEN EXIT DO
  557.        CASE 27
  558.          xk% = 0: EXIT DO
  559.        CASE -75
  560.          xk% = 113: EXIT DO
  561.        CASE -77
  562.          xk% = 114: EXIT DO
  563.        CASE 70, 102, 82, 114, 80, 112, 77, 109, 81, 113, -59
  564.          xk% = t%: EXIT DO
  565.     END SELECT
  566.   LOOP
  567. CALL RestoreScrn(Scrn$)
  568. EXIT SUB
  569.  
  570. DisplayFFchoice:
  571.   st$ = "Browse Records    Alt-B"
  572.   IF c% = 1 THEN colr% = 14: xk% = -48 ELSE colr% = 78
  573.   CALL FastPrint(3, 5, st$, colr%)
  574.   st$ = "Find A Record     Alt-F"
  575.   IF c% = 2 THEN colr% = 14: xk% = -33 ELSE colr% = 78
  576.   CALL FastPrint(4, 5, st$, colr%)
  577.   st$ = "Goto Top Of File  Alt-T"
  578.   IF c% = 3 THEN colr% = 14: xk% = -20 ELSE colr% = 78
  579.   CALL FastPrint(5, 5, st$, colr%)
  580.   st$ = "Goto End Of File  Alt-E"
  581.   IF c% = 4 THEN colr% = 14: xk% = -18 ELSE colr% = 78
  582.   CALL FastPrint(6, 5, st$, colr%)
  583.   st$ = "Get Prev. Record  Alt-P"
  584.   IF c% = 5 THEN colr% = 14: xk% = -25 ELSE colr% = 78
  585.   CALL FastPrint(7, 5, st$, colr%)
  586.   st$ = "Get Next Record   Alt-N"
  587.   IF c% = 6 THEN colr% = 14: xk% = -49 ELSE colr% = 78
  588.   CALL FastPrint(8, 5, st$, colr%)
  589. RETURN
  590. END SUB
  591.  
  592. SUB FindRecord (krs%, ky$, rec$, status%)
  593.   CALL SaveScrn(Scrn$)
  594.   CALL PopWindow(3, 15, 5, 66, 78)
  595.   st$ = "Enter Name to Find:": CALL FastPrint(4, 17, st$, 78)
  596.   DO
  597.     xk% = 11: st$ = SPACE$(29): CALL EditField(4, 37, 15, "", st$, xk%)
  598.     IF xk% = 13 AND st$ <> SPACE$(29) THEN EXIT DO
  599.     IF xk% = 27 THEN GOTO EndFindRecord
  600.   LOOP
  601.   ky$ = st$: rec$ = ""
  602.   CALL GetEqual(krs%, ky$, rec$, rn&, status%)
  603. EndFindRecord:
  604.   CALL RestoreScrn(Scrn$)
  605.   IF status% <> 0 THEN CALL IndexError(status%)
  606. END SUB
  607.  
  608. SUB Help
  609.   CALL SaveScrn(Scrn$)
  610.   CALL PopWindow(8, 14, 16, 66, 78)
  611.   st$ = "Pressing the Highlighted  Letter  (F,R,P,M,Q,F1)"
  612.   CALL FastPrint(10, 17, st$, 79)
  613.   st$ = "will cause  a pull down selection box to appear."
  614.   CALL FastPrint(11, 17, st$, 79)
  615.   st$ = "Make a  selection  by  moving the  highlight  to"
  616.   CALL FastPrint(12, 17, st$, 79)
  617.   st$ = "the selection you want and press enter. Or press"
  618.   CALL FastPrint(13, 17, st$, 79)
  619.   st$ = "the 'Hot' key as indicated (i.e.  Alt-B)"
  620.   CALL FastPrint(14, 17, st$, 79)
  621.   DO
  622.     xk% = KeyIn%
  623.   LOOP UNTIL xk% = 27
  624.   CALL RestoreScrn(Scrn$)
  625. END SUB
  626.  
  627. SUB MiscFunctions (xk%)
  628.   CALL SaveScrn(Scrn$)
  629.   st$ = "Misc.": CALL FastPrint(1, 53, st$, 14)
  630.   CALL PopWindow(2, 53, 6, 78, 78)
  631.   c% = 1: xk% = 0: GOSUB DisplayMFchoice
  632.   DO
  633.     t% = KeyIn%
  634.     SELECT CASE t%
  635.        CASE -80  'up arrow
  636.          c% = c% + 1: IF c% > 3 THEN c% = 1
  637.          GOSUB DisplayMFchoice
  638.        CASE -72  'dn arrow
  639.          c% = c% - 1: IF c% < 1 THEN c% = 3
  640.          GOSUB DisplayMFchoice
  641.        CASE -30, -32, -46
  642.          xk% = t%: EXIT DO
  643.        CASE 13
  644.          IF xk% <> 0 THEN EXIT DO
  645.        CASE 27
  646.          xk% = 0: EXIT DO
  647.        CASE -75
  648.          xk% = 112: EXIT DO
  649.        CASE -77
  650.          xk% = 113: EXIT DO
  651.        CASE 70, 102, 82, 114, 80, 112, 77, 109, 81, 113, -59
  652.          xk% = t%: EXIT DO
  653.     END SELECT
  654.   LOOP
  655. CALL RestoreScrn(Scrn$)
  656. EXIT SUB
  657.  
  658. DisplayMFchoice:
  659.   st$ = "ReIndex Key/Data File"
  660.   IF c% = 1 THEN colr% = 14: xk% = -10 ELSE colr% = 78
  661.   CALL FastPrint(3, 54, st$, colr%)
  662.   st$ = "Close Key/Data Files "
  663.   IF c% = 2 THEN colr% = 14: xk% = -11 ELSE colr% = 78
  664.   CALL FastPrint(4, 54, st$, colr%)
  665.   st$ = "Open Key/Data Files  "
  666.   IF c% = 3 THEN colr% = 14: xk% = -12 ELSE colr% = 78
  667.   CALL FastPrint(5, 54, st$, colr%)
  668.  RETURN
  669.  
  670.  
  671. END SUB
  672.  
  673. SUB OpenFiles
  674.  'krs% = 3: CreateOpenClose (krs%)  'Not being used
  675.  krs% = 2: CreateOpenClose (krs%)
  676.  krs% = 1: CreateOpenClose (krs%)
  677. END SUB
  678.  
  679. SUB PrintFunctions (xk%)
  680.   CALL SaveScrn(Scrn$)
  681.   st$ = "PrintFunctions": CALL FastPrint(1, 37, st$, 14)
  682.   CALL PopWindow(2, 37, 7, 66, 78)
  683.   c% = 1: xk% = 0: GOSUB DisplayPFchoice
  684.   DO
  685.     t% = KeyIn%
  686.     SELECT CASE t%
  687.        CASE -80  'up arrow
  688.          c% = c% + 1: IF c% > 4 THEN c% = 1
  689.          GOSUB DisplayPFchoice
  690.        CASE -72  'dn arrow
  691.          c% = c% - 1: IF c% < 1 THEN c% = 4
  692.          GOSUB DisplayPFchoice
  693.        CASE -30, -32, -46
  694.          xk% = t%: EXIT DO
  695.        CASE 13
  696.          IF xk% <> 0 THEN EXIT DO
  697.        CASE 27
  698.          xk% = 0: EXIT DO
  699.        CASE -75
  700.          xk% = 114: EXIT DO
  701.        CASE -77
  702.          xk% = 109: EXIT DO
  703.        CASE 70, 102, 82, 114, 80, 112, 77, 109, 81, 113, -59
  704.          xk% = t%: EXIT DO
  705.     END SELECT
  706.   LOOP
  707. CALL RestoreScrn(Scrn$)
  708. EXIT SUB
  709.  
  710. DisplayPFchoice:
  711.   st$ = "Print a Mailing Label     "
  712.   IF c% = 1 THEN colr% = 14: xk% = -120 ELSE colr% = 78
  713.   CALL FastPrint(3, 39, st$, colr%)
  714.   st$ = "Print All Mailing Label   "
  715.   IF c% = 2 THEN colr% = 14: xk% = -129 ELSE colr% = 78
  716.   CALL FastPrint(4, 39, st$, colr%)
  717.   st$ = "Print Mailing Label by ZIP"
  718.   IF c% = 3 THEN colr% = 14: xk% = -128 ELSE colr% = 78
  719.   CALL FastPrint(5, 39, st$, colr%)
  720.   st$ = "Print HardCopy Of Record  "
  721.   IF c% = 4 THEN colr% = 14: xk% = -121 ELSE colr% = 78
  722.   CALL FastPrint(6, 39, st$, colr%)
  723.  RETURN
  724.  
  725. END SUB
  726.  
  727. SUB PrintML0
  728.   CALL SaveScrn(Scrn$)
  729.   CALL PopWindow(3, 15, 6, 45, 78)
  730.   st$ = "Start Printing Lables?": CALL FastPrint(4, 17, st$, 78)
  731.   st$ = "ESC to Quit...CR to Print": CALL FastPrint(5, 17, st$, 78)
  732.   DO
  733.     xk% = KeyIn%
  734.     IF xk% = 13 THEN GOSUB ML0Print: EXIT DO
  735.   LOOP UNTIL xk% = 27
  736.   CALL RestoreScrn(Scrn$)
  737.   EXIT SUB
  738.  
  739. ML0Print:
  740.   st$ = SPACE$(29)
  741.   CALL GetEqual(krs%, ky$, rec$, rn&, status%)
  742.   DO
  743.     IF status% <> 0 THEN EXIT DO
  744.     st$ = MID$(rec$, 2, 28): LPRINT st$
  745.     st$ = MID$(rec$, 31, 30): LPRINT st$
  746.     st$ = MID$(rec$, 61, 30): LPRINT st$
  747.     st$ = MID$(rec$, 91, 14) + ", " + MID$(rec$, 105, 2)
  748.     st$ = st$ + MID$(rec$, 107, 5) + "-" + MID$(rec$, 112, 4)
  749.     LPRINT st$
  750.     LPRINT : LPRINT
  751.     CALL GetNext(krs%, ky$, rec$, status%)
  752.   LOOP
  753.  RETURN
  754. END SUB
  755.  
  756. SUB PrintML1 (rec$)
  757.   CALL SaveScrn(Scrn$)
  758.   CALL PopWindow(3, 15, 6, 45, 78)
  759.   st$ = "Print How Many Lables?": CALL FastPrint(4, 17, st$, 78)
  760.   st$ = "ESC to Quit...CR to Print": CALL FastPrint(5, 17, st$, 78)
  761.   DO
  762.     xk% = 2: st$ = "1 ": CALL EditField(4, 40, 15, "", st$, xk%)
  763.     IF xk% = 13 THEN GOSUB ML1Print: EXIT DO
  764.   LOOP UNTIL xk% = 27
  765.   CALL RestoreScrn(Scrn$)
  766.   EXIT SUB
  767.  
  768. ML1Print:
  769.   DO
  770.     c% = c% + 1
  771.     st$ = MID$(rec$, 2, 28): LPRINT st$
  772.     st$ = MID$(rec$, 31, 30): LPRINT st$
  773.     st$ = MID$(rec$, 61, 30): LPRINT st$
  774.     st$ = MID$(rec$, 91, 14) + ", " + MID$(rec$, 105, 2)
  775.     st$ = st$ + MID$(rec$, 107, 5) + "-" + MID$(rec$, 112, 4)
  776.     LPRINT st$
  777.     LPRINT : LPRINT
  778.   LOOP UNTIL c% >= VAL(st$)
  779.  RETURN
  780.  
  781. END SUB
  782.  
  783. SUB PrintML2 (rec$)
  784.   CALL SaveScrn(Scrn$)
  785.   CALL PopWindow(3, 15, 6, 45, 78)
  786.   st$ = "Start Printing Lables?": CALL FastPrint(4, 17, st$, 78)
  787.   st$ = "ESC to Quit...CR to Print": CALL FastPrint(5, 17, st$, 78)
  788.   DO
  789.     xk% = KeyIn%
  790.     IF xk% = 13 THEN GOSUB ML2Print: EXIT DO
  791.   LOOP UNTIL xk% = 27
  792.   CALL RestoreScrn(Scrn$)
  793.   EXIT SUB
  794.  
  795. ML2Print:
  796.   st$ = SPACE$(34)
  797.   krs1% = krs% + 1: CALL GetEqual(krs1%, ky2$, rec$, rn&, status%)
  798.   DO
  799.     IF status% <> 0 THEN EXIT DO
  800.     st$ = MID$(rec$, 2, 28): LPRINT st$
  801.     st$ = MID$(rec$, 31, 30): LPRINT st$
  802.     st$ = MID$(rec$, 61, 30): LPRINT st$
  803.     st$ = MID$(rec$, 91, 14) + ", " + MID$(rec$, 105, 2)
  804.     st$ = st$ + MID$(rec$, 107, 5) + "-" + MID$(rec$, 112, 4)
  805.     LPRINT st$
  806.     LPRINT : LPRINT
  807.     CALL GetNext(krs1%, ky2$, rec$, status%)
  808.   LOOP
  809.  RETURN
  810.  
  811. END SUB
  812.  
  813. SUB PrintML9
  814.   CALL SaveScrn(Scrn$)
  815.   CALL PopWindow(3, 15, 6, 45, 78)
  816.   st$ = "Print Current Record?": CALL FastPrint(4, 17, st$, 78)
  817.   st$ = "ESC to Quit...CR to Print": CALL FastPrint(5, 17, st$, 78)
  818.   DO
  819.     xk% = KeyIn%
  820.     IF xk% = 13 THEN GOSUB ML9Print: EXIT DO
  821.   LOOP UNTIL xk% = 27
  822.   CALL RestoreScrn(Scrn$)
  823.   EXIT SUB
  824.  
  825. ML9Print:
  826.   FOR c% = 81 TO LEN(Scrn$) STEP 2
  827.     LPRINT MID$(Scrn$, c%, 1);
  828.   NEXT
  829.  RETURN
  830.  
  831.  
  832. END SUB
  833.  
  834. SUB QuitFunctions (xk%)
  835.   CALL SaveScrn(Scrn$)
  836.   st$ = "Quit": CALL FastPrint(1, 61, st$, 14)
  837.   CALL PopWindow(2, 61, 5, 76, 78)
  838.   xk% = 0
  839.   DO
  840.     st$ = "Press Alt-Q": CALL FastPrint(3, 64, st$, -1)
  841.     st$ = "  To QUIT  ": CALL FastPrint(4, 64, st$, -1)
  842.     t% = KeyIn%
  843.     SELECT CASE t%
  844.        CASE -75
  845.          xk% = 109: EXIT DO
  846.        CASE -77
  847.          xk% = 102: EXIT DO
  848.        CASE -16, 70, 102, 82, 114, 80, 112, 77, 109, 81, 113, -59
  849.          xk% = t%: EXIT DO
  850.        CASE 27
  851.          xk% = 0: EXIT DO
  852.     END SELECT
  853.   LOOP
  854.   CALL RestoreScrn(Scrn$)
  855. END SUB
  856.  
  857. SUB RecordFunctions (xk%)
  858.   CALL SaveScrn(Scrn$)
  859.   st$ = "RecordFunctions": CALL FastPrint(1, 19, st$, 14)
  860.   CALL PopWindow(2, 19, 6, 45, 78)
  861.   c% = 1: xk% = 0: GOSUB DisplayRFchoice
  862.   DO
  863.     t% = KeyIn%
  864.     SELECT CASE t%
  865.        CASE -80  'up arrow
  866.          c% = c% + 1: IF c% > 3 THEN c% = 1
  867.          GOSUB DisplayRFchoice
  868.        CASE -72  'dn arrow
  869.          c% = c% - 1: IF c% < 1 THEN c% = 3
  870.          GOSUB DisplayRFchoice
  871.        CASE -30, -32, -46
  872.          xk% = t%: EXIT DO
  873.        CASE 13
  874.          IF xk% <> 0 THEN EXIT DO
  875.        CASE 27
  876.          xk% = 0: EXIT DO
  877.        CASE -75
  878.          xk% = 102: EXIT DO
  879.        CASE -77
  880.          xk% = 112: EXIT DO
  881.        CASE 70, 102, 82, 114, 80, 112, 77, 109, 81, 113, -59
  882.          xk% = t%: EXIT DO
  883.     END SELECT
  884.   LOOP
  885. CALL RestoreScrn(Scrn$)
  886. EXIT SUB
  887.  
  888. DisplayRFchoice:
  889.   st$ = "Add a record     Alt-A"
  890.   IF c% = 1 THEN colr% = 14: xk% = -30 ELSE colr% = 78
  891.   CALL FastPrint(3, 21, st$, colr%)
  892.   st$ = "Delete Record    Alt-D"
  893.   IF c% = 2 THEN colr% = 14: xk% = -32 ELSE colr% = 78
  894.   CALL FastPrint(4, 21, st$, colr%)
  895.   st$ = "Change Record    Alt-C"
  896.   IF c% = 3 THEN colr% = 14: xk% = -46 ELSE colr% = 78
  897.   CALL FastPrint(5, 21, st$, colr%)
  898.  RETURN
  899. END SUB
  900.  
  901. SUB ReIndexFile
  902.  'IF krs% = 1 THEN xn% = 1: ifn$ = "ML1.ndx": kl% = 29: df$ = "ML1.Dat": Rfl% = 683
  903.  'IF krs% = 2 THEN xn% = 2: ifn$ = "ML2.ndx": kl% = 34: df$ = "": Rfl% = 0
  904.  'IF krs% = 3 THEN xn% = 3: ifn$ = "ML3.ndx": kl% = 6: df$ = "": Rfl% = 0
  905.  'krs% = -3: CreateOpenClose (krs%)   'Not yet in use
  906.  krs% = -2: CreateOpenClose (krs%)
  907.  krs% = -1: CreateOpenClose (krs%)
  908.  IF FILEXISTS%("ML1.ndx") THEN KILL "ML1.ndx"
  909.  IF FILEXISTS%("ML2.ndx") THEN KILL "ML2.ndx"
  910.  IF FILEXISTS%("ML3.ndx") THEN KILL "ML3.ndx"
  911.  IF FILEXISTS%("ML1.OLD") THEN KILL "ML1.OLD"
  912.  IF FILEXISTS%("ML1.Dat") THEN NAME "ML1.DAT" AS "ML1.OLD" ELSE EXIT SUB
  913.  n% = FREEFILE
  914.  OPEN "ML1.OLd" FOR RANDOM AS n% LEN = 683
  915.  'krs% = 3: CreateOpenClose (krs%)    'Not yet in use
  916.  krs% = 2: CreateOpenClose (krs%)
  917.  krs% = 1: CreateOpenClose (krs%)
  918.  DO
  919.    c& = c& + 1
  920.    rec$ = SPACE$(683): GET #n%, c&, rec$
  921.    IF EOF(n%) THEN EXIT DO
  922.    tb% = 32: ky$ = MID$(rec$, 2, 28) + CHR$(tb%)
  923.    IF MID$(rec$, 2, 28) > SPACE$(28) THEN
  924.      DO
  925.        krs% = 1: CALL AddKeyRec(krs%, ky$, rec$, rn&, status%)
  926.        IF status% = 109 THEN
  927.        IF tb% > 253 THEN EXIT SUB
  928.          tb% = tb% + 1:  ky$ = MID$(rec$, 2, 28) + CHR$(tb%)
  929.        END IF
  930.      LOOP UNTIL status% = 0
  931.      ky2$ = MID$(rec$, 107, 5) + ky$
  932.      krs% = 2: CALL AddKeyRec(krs%, ky2$, "", rn&, status%)
  933.    END IF
  934.  LOOP
  935.  krs% = 2: CALL CreateOpenClose(krs%)
  936.  krs% = 1: CALL CreateOpenClose(krs%)
  937. END SUB
  938.  
  939.