home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / PARASOL / VIDEOSTO.ARK / MENU-MBR.LIB < prev    next >
Text File  |  1986-10-11  |  10KB  |  311 lines
  1. {----------------------------------------------------------------
  2.                                         redefine screen.data;
  3. record  member.rec;
  4.     field   member.member.num   4;
  5.     field   member.type         1;
  6.     field   member.date.joined  8;
  7.     record member.mail;
  8.         field   member.f.name           12;
  9.         field   member.l.name           20;
  10.         field   member.addr             30;
  11.         field   member.city             20;
  12.         field   member.state            2;
  13.         field   member.zip              9;
  14.         endrec;
  15.     field   member.phone        11;
  16.     field   member.sponser      20;
  17.     record  member.employer.mail;
  18.         field   member.empl.name        20;
  19.         field   member.empl.addr        30;
  20.         field   member.empl.city        20;
  21.         field   member.empl.state       2;
  22.         field   member.empl.zip         9;
  23.         endrec;
  24.     field   member.empl.phone   11;
  25.     field   member.empl.period  12;
  26.     field   member.drivers.lic  10;
  27.     field   member.bank.name    20;
  28.     field   member.bank.card    30;
  29.     field   member.charge.card  30;
  30.     endrec;
  31.                                         endredef;
  32.  
  33. procedure   add.member:
  34. begin
  35.  
  36.     {--set up any defaults--}
  37.     fill member.rec with ' ';
  38.     move s.date to member.date.joined;
  39.     move s.city to member.city;
  40.     move s.state to member.state;
  41.     move s.zip to member.zip;
  42.     move 0 to sys.key;
  43.     read sys error standard;
  44.  
  45.     move s.m.nxt to wk.key;
  46.     subtract 1 from wk.key;
  47.     move wk.key to m.key;
  48.     if m.key = 0 then
  49.         move "0" to m.member.num;
  50.     else
  51.         read member error standard;
  52.         fi;
  53.     move m.member.num to wk.str;
  54.     call trunc.wk.str;
  55.     convert wk.str to wk.bcd;
  56.     add 1 to wk.bcd;
  57.     convert wk.bcd to wk.str;
  58.     move wk.str to member.member.num;
  59.  
  60. member.get.data:
  61.     move 'member' to screen.name;
  62.     call get.screen.data;
  63.     move '' to status.line;
  64.     call status.line.display;
  65.     
  66.     {---- test for end or error ----}
  67.     move member.l.name to wk.str;
  68.     call trunc.wk.str;
  69.     if wk.str = '' then
  70.         exit;
  71.         fi;
  72.  
  73.     move member.member.num to wk.str;
  74.     call trunc.wk.str;
  75.     if wk.str = 'END' then
  76.         exit;
  77.         fi;
  78.     if wk.str = '' then
  79.         move 'ERROR- Member number missing' to status.line;
  80.         call status.line.display;
  81.         goto member.get.data;
  82.         fi;
  83.  
  84.     move wk.str to load.m.num;
  85.     call load.m.rec;
  86.     if load.m.key <> 0 then
  87.         move 'ERROR- Duplicate member number.' to status.line;
  88.         call status.line.display;
  89.         goto member.get.data;
  90.         fi;
  91.  
  92.     switch on member.type[byte]:
  93.         "A","L","E":    null;
  94.         else begin
  95.             move "Member-type must be (A)nnual, (L)ife, or (E)xpired"
  96.                                                 to status.line;
  97.             call status.line.display;
  98.             move #member.type to get.data.cursor.loc;
  99.             goto member.get.data;
  100.             end;
  101.         endswitch;
  102.  
  103.     read sys lock error standard;
  104.     move s.m.nxt to m.key;
  105.     move s.m.nxt to mscan.key;
  106.     add 1 to s.m.nxt;
  107.     write sys unlock error standard;
  108.     move member.rec to m.rec;
  109.     write member lock unlock error standard;
  110.     move m.member.num to mscan.member.num;
  111.     write memscan lock unlock error standard;
  112.     close member partial error standard;
  113.     close memscan partial error standard;
  114.  
  115.  
  116. end;
  117.  
  118. {----------------------------------------------------------------
  119.  
  120. procedure   change.member:
  121. begin
  122.  
  123.  
  124.     move 0 to sys.key;
  125.     read sys error standard;
  126.  
  127. chg.mem.get.data:
  128.     call find.mem.num;
  129.     call trunc.wk.str;
  130.     if wk.str = '' then
  131.         exit;
  132.         fi;
  133.     if wk.str = 'END' then
  134.         exit;
  135.         fi;
  136.     move wk.str to load.m.num;
  137.     call load.m.rec;
  138.     if load.m.key = 0 then
  139.         move 'ERROR- Member number not found- Enter END or number.'
  140.                                                     to status.line;
  141.         call status.line.display;
  142.         goto chg.mem.get.data;
  143.         fi;
  144.     move load.m.key to m.key;
  145.     read member error standard;
  146.     move m.rec to member.rec;
  147.     move 'member' to screen.name;
  148.     call get.screen.data;
  149.     move member.rec to m.rec;
  150.     move m.member.num to wk.str;
  151.     call trunc.wk.str;
  152.     if wk.str = 'END' then
  153.         exit;
  154.         fi;
  155.     switch on m.type[byte]:
  156.         "A","L","E":    null;
  157.         else begin
  158.             move "Member-type must be (A)nnual, (L)ife, or (E)xpired"
  159.                                                 to status.line;
  160.             call status.line.display;
  161.             move #member.type to get.data.cursor.loc;
  162.             goto chg.mem.get.data;
  163.             end;
  164.         endswitch;
  165.     move m.member.num to mscan.member.num;
  166.     write memscan lock unlock error standard;
  167.     write member lock unlock error standard;
  168. end;
  169.  
  170. {----------------------------------------------------------------}
  171. procedure find.mem.num:
  172. begin
  173.                                 redefine screen.data;
  174.     record msearch.rec;
  175.  
  176.         field   sch.mem.num 4;
  177.         field   sch.pattern 30;
  178.     record    sch.reply.area;
  179.             record sch.found.pat;
  180.                 field   sch.pat.mem.num 4;
  181.                 field   sch.pat.name    25;
  182.                 field   sch.pat.addr    35;
  183.                 endrec;
  184.             string (##sch.found.pat * 14 );
  185.             endrec;
  186.         endrec;
  187.                                     endredef;
  188.  
  189.  
  190.     do
  191.         move #sch.pat.mem.num to wk.sp;
  192.         move 0 to wk.count;
  193.  
  194.         move 0 to sys.key;
  195.         read sys error standard;
  196.  
  197.  
  198. sch.get.data:
  199.         fill msearch.rec with ' ';
  200.         move 'msearch' to screen.name;
  201.         call get.screen.data;
  202. retry.mem.entry:
  203.         fill sch.reply.area with ' ';
  204.         move ' ' to status.line;
  205.         call status.line.display;
  206.  
  207.         move sch.pattern to wk.str;
  208.         call trunc.wk.str;
  209.         move wk.str to wk.str.2;
  210.         move sch.mem.num to wk.str;
  211.         call trunc.wk.str;
  212.  
  213.         if wk.str = '' and wk.str.2 = '' then
  214.             move 'ERROR- Enter member number or name or ?.' to status.line;
  215.             call status.line.display;
  216.             goto sch.get.data;
  217.             fi;
  218.  
  219.         move ' ' to status.line;
  220.         call status.line.display;
  221.         if wk.str = 'END' then
  222.             exit;
  223.             fi;
  224.         if wk.str <> '' then    {--exit if a member # was entered--}
  225.             exit;
  226.             fi;
  227.  
  228.         move wk.str.2 to cur.pattern;
  229.         convert cur.pattern to upper case;
  230.         move '' to sch.pattern;
  231.         move 1 to wk.key;
  232.  
  233.         while wk.key < s.m.nxt do
  234.             move wk.key to m.key;
  235.             read member  error standard;
  236.  
  237.             move m.type to wk.str;
  238.             call trunc.wk.str;
  239.             if wk.str = '' then
  240.                 goto sch.skip.display;
  241.                 fi;
  242.             move m.f.name to wk.str;
  243.             move m.l.name to wk.str.2;
  244.             append wk.str.2 to wk.str;
  245.             convert wk.str to upper case;
  246.             if cur.pattern = '?' then
  247.                 move '?' to wk.str;
  248.                 fi;
  249.             scan wk.str for cur.pattern true
  250.             begin
  251.                 move m.member.num to wk.str.edit[field,
  252.                                                 length ##sch.pat.mem.num];
  253.                 move wk.str.edit to @wk.sp length ##sch.pat.mem.num;
  254.                 add ##sch.pat.mem.num to wk.sp;
  255.  
  256.                 move m.f.name to wk.str;
  257.                 call trunc.wk.str;
  258.                 move wk.str to wk.str.2;
  259.                 move m.l.name to wk.str;
  260.                 call trunc.wk.str;
  261.                 append ' ' to wk.str.2;
  262.                 append wk.str to wk.str.2;
  263.                 move wk.str.2 to wk.str.edit[field, length ##sch.pat.name];
  264.                 move wk.str.edit to @wk.sp length ##sch.pat.name;
  265.                 add ##sch.pat.name to wk.sp;
  266.  
  267.                 move m.addr to wk.str;
  268.                 call trunc.wk.str;
  269.                 move wk.str to wk.str.2;
  270.                 move m.city to wk.str;
  271.                 call trunc.wk.str;
  272.                 append ' ' to wk.str.2;
  273.                 append wk.str to wk.str.2;
  274.                 move m.state to wk.str;
  275.                 append ' ' to wk.str.2;
  276.                 append wk.str to wk.str.2;
  277.                 move wk.str.2 to wk.str.edit[field, length ##sch.pat.addr];
  278.                 move wk.str.edit to @wk.sp length ##sch.pat.addr;
  279.                 add ##sch.pat.addr to wk.sp;
  280.  
  281.                 add 1 to wk.count;
  282.             end;
  283. sch.skip.display:
  284.  
  285.             add 1 to wk.key;
  286.             if wk.count >= 15 or wk.key >= s.m.nxt then
  287.                 if wk.key >= s.m.nxt then
  288.                     move '>>> Search complete- Enter END or Member number or ?.'
  289.                                                         to status.line;
  290.                 else
  291.                     move '>>> Search not complete- Exit screen to continue.'
  292.                                                         to status.line;
  293.                     fi;
  294.                 call status.line.display;
  295.                 call get.screen.data;
  296.                 if sch.mem.num <> " "
  297.                 or sch.pattern <> " " then
  298.                     move #sch.pat.mem.num to wk.sp;
  299.                     move 0 to wk.count;
  300.                     goto retry.mem.entry;
  301.                     fi;
  302.                 move #sch.pat.mem.num to wk.sp;
  303.                 move 0 to wk.count;
  304.                 fill msearch.rec with ' ';
  305.                 fi;
  306.             od;
  307.         od;
  308. end;
  309.  
  310. {----------------------------------------------------------------
  311.