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 / VIDMENU.SRC < prev    next >
Text File  |  1986-09-26  |  38KB  |  1,195 lines
  1. copy "PARMS.LIB";
  2. video.management.main.menu:
  3. begin
  4.  
  5. copy "SYSPARMS.FIL";
  6. copy "MEMBER.FIL";
  7. copy "TAPE.FIL";
  8. copy "TSCAN.FIL";
  9. copy "MSCAN.FIL";
  10. copy "SORT.FIL";
  11. copy "STARTUP.FIL";
  12. copy "BOJDATA.LIB";
  13. copy "SCREEN.LIB";
  14. copy "FULLSORT.LIB";
  15. copy "REPORT.LIB";
  16.  
  17. string  wk.str      81;
  18. string  wk.str.2    81;
  19. string  wk.str.edit 81;
  20. string  cur.pattern 30;
  21. string  wk.date     9;
  22. string  curr.report.type    5;
  23. string  pointer wk.sp;
  24. word    pointer wk.wp;
  25.  
  26. byte    wk.byte;
  27. byte    type.of.sort;       {M=member  T=tape}
  28. {----byte    pr.type;            {T=Tapes, X=xrated, I=inventory}
  29. byte    pr.sort.select;     {M=Member#, T=Title}
  30. byte    pointer wk.bp;
  31. byte    rpt.ch;
  32.  
  33. word    wk.word;
  34. word    wk.key;
  35. word    wk.key.2;
  36. word    wk.count;
  37. word    sort.in.key;
  38. word    sort.out.key;
  39.  
  40. bcd wk.bcd;
  41.  
  42. external label entry address 5;
  43.  
  44.  
  45. string  cmp.date.1      9;      { for procedure cmp.date }
  46. string  cmp.date.2      9;
  47. byte    cmp.date.result;
  48.  
  49. string  load.t.num      5;      { for procedure load.t.rec  }
  50. string  load.m.num      5;      {for procedure load.m.rec   }
  51. word    load.t.key;
  52. word    load.m.key;
  53. {----------------------------------------------------------------
  54. procedure    read.sys:    read sys fresh error standard;
  55. procedure    read.sys.lk:    read sys lock error standard;
  56. procedure    write.sys.unlk:    write sys unlock error standard;
  57.  
  58. copy "TRUNCSTR.LIB";
  59. copy "SELPRINT.LIB";
  60. copy "PRINTERS.LIB";
  61. copy "MENU-MBR.LIB";
  62. copy "MENU-TAP.LIB";
  63. {---------------------------------------------------------------}
  64. procedure check.tape:
  65. begin
  66.  
  67.                         redefine screen.data;
  68. record  chk.rec;
  69.     field   chk.member.num  4;
  70.     field   chk.in.num      4;
  71.     field   chk.out.num     4;
  72.     field   chk.out.date    8;
  73.     field   chk.due.date    8;
  74.     record  chk.list.clear;
  75.         record  chk.list.rec;
  76.             field   chk.list.tape       4;
  77.             field   chk.list.title      30;
  78.             field   chk.list.out        8;
  79.             field   chk.list.due        8;
  80.             field   chk.list.flag       1;
  81.                 endrec;
  82.         string  ( ##chk.list.rec * 9);
  83.     endrec;
  84. endrec;
  85.                         endredef;
  86.  
  87. byte    chk.switch;         {I= check in  O=check out}
  88. byte    member.has.tape;    {Y=yes , N=no}
  89.  
  90. {-------------------------------------------------------------------}
  91. {-------- Sub-procedure <list.chk.rec> for <check.tape>-------------}
  92. {-------------------------------------------------------------------}
  93. procedure list.chk.rec:
  94. begin
  95.     fill chk.list.clear with ' ';
  96.     move #chk.list.rec to wk.sp;
  97.     move 0 to wk.count;
  98.     move chk.member.num to wk.str;
  99.     call trunc.wk.str;
  100.     move wk.str to wk.str.2;
  101.     move 1 to wk.key;
  102.     move 'N' to member.has.tape;
  103.     while wk.key <= s.t.nxt do
  104.         move wk.key to tscan.key;
  105.         read tapescan error standard;
  106.         move tscan.member.num to wk.str;
  107.         call trunc.wk.str;
  108.         if wk.str = wk.str.2 then
  109.             move wk.key to t.key;
  110.             read tape error standard;
  111.             move t.stock.num to wk.str.edit[field, length ##chk.list.tape];
  112.             move wk.str.edit to @wk.sp length ##chk.list.tape;
  113.             add ##chk.list.tape to wk.sp;
  114.  
  115.             move t.title to wk.str.edit[field, length ##chk.list.title];
  116.             move wk.str.edit to @wk.sp length ##chk.list.title;
  117.             add ##chk.list.title to wk.sp;
  118.  
  119.             move t.out.date to wk.str.edit[field, length ##chk.list.out];
  120.             move wk.str.edit to @wk.sp length ##chk.list.out;
  121.             add ##chk.list.out to wk.sp;
  122.  
  123.             move t.due.date to wk.str.edit[field, length ##chk.list.due];
  124.             move wk.str.edit to @wk.sp length ##chk.list.due;
  125.             add ##chk.list.due to wk.sp;
  126.  
  127.             move s.date to cmp.date.1;
  128.             move t.due.date to cmp.date.2;
  129.             call cmp.date;
  130.             if cmp.date.result = '>' then
  131.                 move '*' to wk.str.edit;
  132.             else
  133.                 move ' ' to wk.str.edit;
  134.                 fi;
  135.             move wk.str.edit to @wk.sp length ##chk.list.flag;
  136.             add ##chk.list.flag to wk.sp;
  137.  
  138.             move 'Y' to member.has.tape;
  139.             add 1 to wk.count;
  140.             fi;
  141.  
  142.         add 1 to wk.key;
  143.         if wk.count >= 10 or wk.key >= s.t.nxt then
  144.             if wk.key >= s.t.nxt then
  145.                 move '>>> Check out list complete.' to status.line;
  146.             else
  147.                 move '>>> Search incomplete- exit screen to continue.'
  148.                         to status.line;
  149.                 fi;
  150.             call status.line.display;
  151.             if wk.key >= s.t.nxt then 
  152.                 exitdo;
  153.             else
  154.                 call get.screen.data;
  155.                 move #chk.list.rec to wk.sp;
  156.                 move 0 to wk.count;
  157.                 fill chk.list.clear with ' ';
  158.                 fi;
  159.             fi;
  160.         od;
  161. end;
  162. {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
  163.     move 0 to sys.key;
  164.     read sys error standard;
  165. chk.get.data:
  166.     fill chk.rec with ' ';
  167.     move s.date to chk.out.date;
  168. chk.get.data.2:
  169.     move 'check' to screen.name;
  170.     call get.screen.data;
  171.     move ' ' to status.line;
  172.     call status.line.display;
  173.  
  174.     move chk.member.num to wk.str;
  175.     call trunc.wk.str;
  176.     if wk.str = '' then 
  177.         call find.mem.num;
  178.         fill chk.rec with ' ';
  179.         move s.date to chk.out.date;
  180.         move wk.str to wk.str.edit [field, length ##chk.member.num];
  181.         move wk.str.edit to chk.member.num;
  182.         goto chk.get.data.2;
  183.         fi;
  184.  
  185.     if wk.str = 'END' then
  186.         exit
  187.         fi;
  188.     move chk.out.num to wk.str;
  189.     call trunc.wk.str;
  190.     move wk.str to wk.str.2;
  191.     move chk.in.num to wk.str;
  192.     call trunc.wk.str;
  193.  
  194.     if wk.str <> '' and wk.str.2 <> '' then 
  195.         move 'ERROR- Enter only tape# check in or out, not both.'
  196.             to status.line;
  197.         call status.line display;
  198.         goto chk.get.data.2;
  199.         fi;
  200.     if wk.str = '' and wk.str.2 = '' then
  201.         call list.chk.rec;
  202.         if member.has.tape = 'N' then
  203.             move '>>> No tapes found for this member.' to status.line;
  204.         else
  205.             move '>>>  Enter tape# or END to exit.' to status.line;
  206.             fi;
  207.         call status.line.display;
  208.         goto chk.get.data.2;
  209.         fi;
  210.  
  211.     fill t.rec with ' ';
  212.     if wk.str <> '' then
  213.         move wk.str to load.t.num;
  214.         move 'I' to chk.switch;
  215.     else
  216.         move wk.str.2 to load.t.num;
  217.         move 'O' to chk.switch;
  218.         fi;
  219.  
  220.     call load.t.rec;
  221.     if load.t.key <> 0 then
  222.         move load.t.key to tscan.key;
  223.         move chk.member.num to wk.str;
  224.         call trunc.wk.str;
  225.         move wk.str to wk.str.2;
  226.         move t.member.num to wk.str;
  227.         call trunc.wk.str;
  228.         switch on chk.switch:
  229.             'I': begin
  230.                     move 1 to get.data.skip.count;
  231.                     if wk.str = '' then 
  232.                         move 'ERROR- Tape not checked out.' to status.line;
  233.                         call status.line.display;
  234.                         goto chk.get.data.2;
  235.                         fi;
  236.  
  237.  
  238.                     if wk.str <> wk.str.2 then
  239.                         move 'ERROR- Tape checked out to member #'
  240.                             to status.line;
  241.                         append wk.str to status.line;
  242.                         call status.line.display;
  243.                         goto chk.get.data.2;
  244.                         fi;
  245.                     fill chk.in.num with ' ';
  246.                     fill t.chk.rec with ' ';
  247.                     fill tscan.member.num with ' ';
  248.                     end;
  249.             'O': begin
  250.                     move 2 to get.data.skip.count;
  251.                     if wk.str <> '' then
  252.                         move 'ERROR- Tape checked out to member# '
  253.                             to status.line;
  254.                         append wk.str to status.line;
  255.                         call status.line.display;
  256.                         goto chk.get.data.2;
  257.                         fi;
  258.                     move chk.member.num to t.member.num;
  259.                     move chk.member.num to tscan.member.num;
  260.                     move chk.out.date to t.out.date;
  261.                     move chk.due.date to t.due.date;
  262.                     fill chk.out.num with ' ';
  263.  
  264.                     move t.count to wk.str;
  265.                     call trunc.wk.str;
  266.                     convert wk.str to wk.bcd;
  267.                     if wk.bcd = 999 then
  268.                         move 0 to wk.bcd;
  269.                         fi;
  270.                     add 1 to wk.bcd;
  271.                     convert wk.bcd to wk.str;
  272.                     move wk.str to wk.str.edit[field,length ##t.count];
  273.                     move wk.str.edit to t.count;
  274.                     end;
  275.             endswitch;
  276.  
  277.         write tapescan error standard;
  278.         write tape error standard;
  279.  
  280.     else
  281.         move 'ERROR- Tape number not found.' to status.line;
  282.         call status.line.display;
  283.         switch on chk.switch:
  284.             'I': move 1 to get.data.skip.count;
  285.             'O': move 2 to get.data.skip.count;
  286.             endswitch;
  287.         fi;
  288.     goto chk.get.data.2;
  289. end;
  290. {---------------------------------------------------------------}
  291. procedure load.t.rec:
  292. begin
  293.     move 1 to load.t.key;
  294.     while load.t.key < s.t.nxt do
  295.         move load.t.key to tscan.key;
  296.         read tapescan error standard;
  297.         move tscan.stock.num to wk.str;
  298.         call trunc.wk.str;
  299.         if  wk.str = load.t.num then 
  300.             move load.t.key to t.key;
  301.             read tape error standard;
  302.             exit;
  303.         else
  304.             add 1 to load.t.key;
  305.             fi;
  306.         od;
  307.     if load.t.key = s.t.nxt then
  308.         move 0 to load.t.key;
  309.         fi;
  310. end;
  311. {---------------------------------------------------------------}
  312. procedure load.m.rec:
  313. begin
  314.     move 1 to load.m.key;
  315.     while load.m.key < s.m.nxt do
  316.         move load.m.key to mscan.key;
  317.         read memscan error standard;
  318.         move mscan.member.num to wk.str;
  319.         call trunc.wk.str;
  320.         if  wk.str = load.m.num then 
  321.             move load.m.key to m.key;
  322.             read member error standard;
  323.             exit;
  324.         else
  325.             add 1 to load.m.key;
  326.             fi;
  327.         od;
  328.     if load.m.key = s.m.nxt then
  329.         move 0 to load.m.key;
  330.         fi;
  331. end;
  332. {---------------------------------------------------------------}
  333. procedure justify.tape.fields:
  334. begin
  335.     move t.stock.num to wk.str;
  336.     justify wk.str right length ##t.stock.num;
  337.     move wk.str to t.stock.num;
  338.  
  339.     move t.rating to wk.str;
  340.     justify wk.str left length ##t.rating;
  341.     move wk.str to t.rating;
  342.  
  343.     move t.member.num to wk.str;
  344.     justify wk.str right length ##t.member.num;
  345.     move wk.str to t.member.num;
  346. end;
  347. {----------------------------------------------------------------}
  348. procedure justify.member.fields:
  349. begin
  350.     move m.member.num to wk.str;
  351.     justify wk.str right length ##m.member.num;
  352.     move wk.str to m.member.num;
  353.  
  354.     move m.zip to wk.str.2;
  355.     edit wk.str.2 with 'ZZZZ99999' giving wk.str;
  356.     justify wk.str left length ##m.zip;
  357.     move wk.str to m.zip;
  358. end;
  359.  
  360. {--------------------------------------------------------------}
  361. procedure justify.inv.fields:
  362. begin
  363.     move t.purchase.price to wk.str.2;
  364.     edit wk.str.2 with 'ZZXXXX' giving wk.str;
  365.     move wk.str to t.purchase.price length ##t.purchase.price;
  366.  
  367.     move t.retail.price to wk.str.2;
  368.     edit wk.str.2 with 'ZZXXXX' giving wk.str;
  369.     move wk.str to t.retail.price length ##t.retail.price;
  370.  
  371.     move t.count to wk.str;
  372.     justify wk.str right length ##t.count;
  373.     move wk.str to t.count;
  374. end;
  375. {----------------------------------------------------------------
  376. procedure   printing.menu:
  377. begin                                        redefine screen.data;
  378. field   prmenu.option   3;
  379. field   prmenu.date     8;                                        endredef;
  380.  
  381.     move ' ' to prmenu.option;
  382.     move ' ' to prmenu.date;
  383.     do
  384.         move 60 to line.counter;
  385.         move 'prmenu' to screen.name;
  386.         call get.screen.data;
  387.         move ' ' to status.line;
  388.         call status.line.display;
  389.         move s.date to report.date;
  390.         move prmenu.date to wk.date;
  391.         move prmenu.option to curr.report.type;
  392.         move prmenu.option[+2,byte] to pr.sort.select;
  393.         switch on curr.report.type:
  394.             'MEM':                          call member.list;
  395.             'TAP','INV','XRA','CHM','CHT':  call tape.list;
  396.             'STI','STO':                    call tape.list;
  397.             'END':                          exit;
  398.             else begin
  399.                 move 'Invalid Option' to status.line;
  400.                 call status.line.display;
  401.                 end;
  402.             endswitch;
  403.         od;
  404. end;
  405.  
  406. {-------------------------------------------------------------}
  407. procedure tape.list:
  408. begin
  409.     string  last.title  46;
  410.     string  this.title  46;
  411.  
  412.     move 0 to sys.key;
  413.     read sys error standard;
  414.     move 0 to sort.in.key;
  415.     move 0 to sort.out.key;
  416.     switch on curr.report.type:
  417.         'STI','STO':    move "D" to type.of.sort;
  418.         else            move 'T' to type.of.sort;
  419.         endswitch;
  420.     move type.of.sort to csort.name.code;
  421.     open csort error
  422.                open csort output remove error standard;
  423.     call full.sort;
  424.     move 0 to csort.key;
  425.     read csort error standard;
  426.     move csort.nxt to wk.key.2;
  427. {*debug*    convert csort.nxt to wk.str;
  428. {*debug*    display "csort.nxt = ",wk.str; accept wk.str;
  429.     move 1 to wk.key;
  430.  
  431.     switch on curr.report.type:
  432.         'STI',
  433.         'STO',
  434.         'INV',
  435.         'XRA',
  436.         'TAP': begin
  437.                 move s.wide.printer to printer.to.select;
  438.                 call select.printer;
  439.                 end;
  440.         'CHM',
  441.         'CHT': begin
  442.                 move s.narrow.printer to printer.to.select;
  443.                 call select.printer;
  444.                 move 79 to report.width;
  445.                 end;
  446.         endswitch;
  447.     call init.report;
  448.  
  449.     move s.name to heading.1;
  450.     switch on curr.report.type:
  451.         'INV': move 'Inventory List'        to heading.2;
  452.         'CHT',
  453.         'CHM': move 'Check Out List'        to heading.2;
  454.         'STI':  move 'In-Stock List'        to heading.2;
  455.         'STO':  move 'Out-of-Stock List'    to heading.2;
  456.         'XRA',
  457.         'TAP': begin
  458.                     call build.store.addr;
  459.                     move wk.str to heading.2;
  460.                     end;
  461.         endswitch;
  462.  
  463.     move ' ' to this.title;
  464.  
  465.     while wk.key < wk.key.2 do
  466.         move this.title to last.title;
  467.         move wk.key to csort.key;
  468. {*debug*        convert csort.key to wk.str;
  469. {*debug*        display "Reading csort rec # ",wk.str,;
  470.         read csort error standard;
  471.         move csort.code.key to t.key;
  472. {*debug*        convert t.key to wk.str;
  473. {*debug*        display "   Tape Rec # ",wk.str;
  474.         read tape error standard;
  475.  
  476.         call justify.tape.fields;
  477.  
  478.         move t.date.out.stock to wk.str;
  479.         call trunc.wk.str;
  480.         if curr.report.type = 'XRA' and wk.str <> '' then
  481.             goto skip.print;
  482.             fi;
  483.         if curr.report.type = 'TAP' and wk.str <> '' then
  484.             goto skip.print;
  485.             fi;
  486.         if curr.report.type = 'XRA' and t.rating <> 'X' then
  487.             goto skip.print;
  488.             fi;
  489.         if curr.report.type = 'TAP' and t.rating = 'X' then 
  490.             goto skip.print;
  491.             fi;
  492.         if curr.report.type = 'STI' and t.date.out.stock <> ' ' then
  493.             goto skip.print;
  494.             fi;
  495.         if curr.report.type = 'STO' and t.date.out.stock = ' ' then
  496.             goto skip.print;
  497.             fi;
  498.         if curr.report.type = 'STI'
  499.         or curr.report.type = 'STO'
  500.         or curr.report.type = 'CHT'
  501.         or curr.report.type = 'CHM'
  502.         or curr.report.type = 'INV' then
  503.             move ' ' to last.title;
  504.             fi;
  505.  
  506.         move t.title to wk.str;
  507.         call trunc.wk.str;
  508.         move wk.str to this.title;
  509.         if this.title <> last.title then
  510.             switch on curr.report.type:
  511.                 'XRA': begin
  512.                         if t.stock.num <> '9999' then
  513.                             call pr.tape.list;
  514.                             fi;
  515.                         end;
  516.                 'STI',
  517.                 'STO': call pr.inv.list;
  518.                 'TAP': call pr.tape.list;
  519.                 'INV': begin
  520.                         if t.stock.num <> '9999' then
  521.                             call pr.inv.list;
  522.                             fi;
  523.                         end;
  524.                 'CHM',
  525.                 'CHT': call pr.chk.list;
  526.                 endswitch;
  527.             fi;
  528.  
  529. skip.print:
  530.         add 1 to wk.key;
  531.         od;
  532.     move s.narrow.printer to printer.to.select;
  533.     call select.printer;
  534.     call end.report;
  535.     close csort error standard;
  536. end;
  537. {-------------------------------------------------------------}
  538. procedure pr.tape.list:
  539. begin
  540.                         redefine report.line;
  541.     field                       4;
  542.     field   pr.t.stock.num      4;
  543.     field                       3;
  544.     field   pr.new              3;
  545.     field                       2;
  546.     field   pr.t.title          45;
  547.     field                       6;
  548.     field   pr.t.star.1         20;
  549.     field                       4;
  550.     field   pr.t.star.2         20;
  551.     field                       4;
  552.     field   pr.t.rating         2;
  553.     field                       4;
  554.     field   pr.t.category       7;
  555.     field                       4;
  556.                         endredef;
  557.  
  558.     move t.stock.num to pr.t.stock.num;
  559.  
  560.     move ' ' to pr.new;
  561.     move wk.date to cmp.date.1;
  562.     move t.date.in.stock to cmp.date.2;
  563.     call cmp.date;
  564.     if cmp.date.result = '<' or cmp.date.result = '=' then
  565.         move 'NEW' to pr.new;
  566.         fi;
  567.  
  568.     move t.title to pr.t.title;
  569.     move t.star.1 to pr.t.star.1;
  570.     move t.star.2 to pr.t.star.2;
  571.     move t.rating to pr.t.rating;
  572.     move t.category to pr.t.category;
  573.     call print.report.line;
  574. end;
  575.  
  576. {-------------------------------------------------------------}
  577. procedure pr.inv.list:
  578. begin
  579.  
  580.                                             redefine report.line;
  581. field                       5;
  582. field   pr.t.stock.num      4;
  583. field                       4;
  584. field   pr.t.title          45;
  585. field                       4;
  586. field   pr.t.purchase.price 6;
  587. field                       4;
  588. field   pr.t.retail.price   6;
  589. field                       4;
  590. field   pr.t.purchased.from 20;
  591. field                       2;
  592. field   pr.t.date.in.stock  8;
  593. field                       2;
  594. field   pr.t.date.out.stock 8;
  595. field                       3;
  596. field   pr.t.count          3;
  597. field                       4;
  598.                                             endredef;
  599.  
  600.     call justify.inv.fields;
  601.     move t.stock.num to pr.t.stock.num;
  602.     move t.title to pr.t.title;
  603.     move t.purchase.price to pr.t.purchase.price;
  604.     move t.retail.price to pr.t.retail.price;
  605.     move t.purchased.from to pr.t.purchased.from;
  606.     move t.date.in.stock to pr.t.date.in.stock;
  607.     move t.date.out.stock to pr.t.date.out.stock;
  608.     move t.count to pr.t.count;
  609.  
  610.     call print.report.line;
  611. end;
  612. {--------------------------------------------------------------}
  613. procedure pr.chk.list:
  614. begin
  615.                             redefine report.line;
  616.     field                       2;
  617.     field   pr.t.stock.num      4;
  618.     field                       2;
  619.     field   pr.t.title          30;
  620.     field                       4;
  621.     field   pr.t.member.num     4;
  622.     field                       4;
  623.     field   pr.t.out.date       8;
  624.     field                       2;
  625.     field   pr.t.due.date       8;
  626.     field                       5;
  627.     field   pr.t.overdue        1;
  628.     field                       6;
  629.                             endredef;
  630.  
  631.     move t.member.num to wk.str;
  632.     call trunc.wk.str;
  633.     if wk.str = '' then
  634.         exit;
  635.         fi;
  636.  
  637.     move t.stock.num to pr.t.stock.num;
  638.     move t.title to pr.t.title;
  639.     move t.member.num to pr.t.member.num;
  640.     move t.out.date to pr.t.out.date;
  641.     move t.due.date to pr.t.due.date;
  642.  
  643.     move s.date to cmp.date.1;
  644.     move t.due.date to cmp.date.2;
  645.     call cmp.date;
  646.     if cmp.date.result = '>' then
  647.         move '*' to pr.t.overdue;
  648.     else
  649.         move ' ' to pr.t.overdue;
  650.         fi;
  651.     call print.report.line;
  652. end;
  653. {-------------------------------------------------------------}
  654. procedure build.store.addr:
  655. begin
  656.     move s.addr to wk.str;
  657.     call trunc.wk.str;
  658.     move wk.str to wk.str.2;
  659.     append ' ' to wk.str.2;
  660.     move s.city to wk.str;
  661.     call trunc.wk.str;
  662.     append ',' to wk.str;
  663.     append wk.str to wk.str.2;
  664.     move s.state to wk.str;
  665.     append ' ' to wk.str;
  666.     append wk.str to wk.str.2;
  667.     move s.zip to wk.str;
  668.     call trunc.wk.str;
  669.     append ' ' to wk.str;
  670.     append wk.str to wk.str.2;
  671.     move s.phone to wk.str;
  672.     append wk.str to wk.str.2;
  673.     move wk.str.2 to wk.str;
  674. end;
  675. {-------------------------------------------------------------}
  676. procedure report.heading:
  677. begin
  678.  
  679. record  pr.hdg.1;
  680.     field   4   value   ' ';
  681.     field   5   value   'Tape#';
  682.     field   27  value   ' ';
  683.     field   5   value   'Title';
  684.     field   26  value   ' ';
  685.     field   8   value   'Starring';
  686.     field   38  value   ' ';
  687.     field   6   value   'Rating';
  688.     field   2   value   ' ';
  689.     field   8   value   'Category';
  690.     field   3   value   ' ';
  691.     byte    value   0;
  692. endrec;
  693.  
  694. record pr.hdg.2;
  695.     field   4   value   ' ';
  696.     field   5   value   '-----';
  697.     field   27  value   ' ';
  698.     field   5   value   '-----';
  699.     field   26  value   ' ';
  700.     field   8   value   '--------';
  701.     field   38  value   ' ';
  702.     field   6   value   '------';
  703.     field   2   value   ' ';
  704.     field   8   value   '--------';
  705.     field   2   value   ' ';
  706.     byte    value   0;
  707. endrec;
  708.  
  709. record  pr.hdg.3;
  710.     field   4   value   ' ';
  711.     field   6   value   'Stock#';
  712.     field   8   value   ' ';
  713.     field   5   value   'Title';
  714.     field   39  value   ' ';
  715.     field   8   value   'Purchase';
  716.     field   2   value   ' ';
  717.     field   6   value   'Retail';
  718.     field   4   value   ' ';
  719.     field   14  value   'Purchased from';
  720.     field   8   value   ' ';
  721.     field   8   value   'In stock';
  722.     field   2   value   ' ';
  723.     field   9   value   'Out stock';
  724.     field   2   value   ' ';
  725.     field   5   value   'Count';
  726.     field   2   value   ' ';
  727.     byte    value   0;
  728. endrec;
  729.  
  730. record  pr.hdg.4;
  731.     field   4   value   ' ';
  732.     field   6   value   '------';
  733.     field   8   value   ' ';
  734.     field   5   value   '-----';
  735.     field   39  value   ' ';
  736.     field   8   value   '--------';
  737.     field   2   value   ' ';
  738.     field   6   value   '------';
  739.     field   4   value   ' ';
  740.     field   14  value   '--------------';
  741.     field   8   value   ' ';
  742.     field   8   value   '--------';
  743.     field   2   value   ' ';
  744.     field   9   value   '---------';
  745.     field   2   value   ' ';
  746.     field   5   value   '-----';
  747.     field   2   value   ' ';
  748.     byte    value   0;
  749. endrec;
  750.  
  751. record  pr.hdg.5;
  752.     field   3   value   ' ';
  753.     field   6   value   'Number';
  754.     field   2   value   ' ';
  755.     field   4   value   'Name';
  756.     field   32  value   ' ';
  757.     field   7   value   'Address';
  758.     field   62  value   ' ';
  759.     field   4   value   'Date';
  760.     field   6   value   ' ';
  761.     field   4   value   'Type';
  762.     field   2   value   ' ';
  763.     byte    value   0;
  764. endrec;
  765.  
  766. record  pr.hdg.6;
  767.     field   3   value   ' ';
  768.     field   6   value   '------';
  769.     field   2   value   ' ';
  770.     field   4   value   '----';
  771.     field   32  value   ' ';
  772.     field   7   value   '-------';
  773.     field   62  value   ' ';
  774.     field   4   value   '----';
  775.     field   6   value   ' ';
  776.     field   4   value   '----';
  777.     field   2   value   ' ';
  778.     byte    value   0;
  779. endrec;
  780.  
  781. record  pr.hdg.7;
  782.     field   1   value   ' ';
  783.     field   5   value   'Tape#';
  784.     field   2   value   ' ';
  785.     field   5   value   'Title';
  786.     field   27  value   ' ';
  787.     field   7   value   'Member#';
  788.     field   5   value   ' ';
  789.     field   3   value   'Out';
  790.     field   7   value   ' ';
  791.     field   3   value   'Due';
  792.     field   5   value   ' ';
  793.     field   7   value   'Overdue';
  794.     field   3   value   ' ';
  795.     byte        value   0;
  796. endrec;
  797.  
  798. record  pr.hdg.8;
  799.     field   1   value   ' ';
  800.     field   5   value   '-----';
  801.     field   2   value   ' ';
  802.     field   5   value   '-----';
  803.     field   27  value   ' ';
  804.     field   7   value   '-------';
  805.     field   5   value   ' ';
  806.     field   3   value   '---';
  807.     field   7   value   ' ';
  808.     field   3   value   '---';
  809.     field   5   value   ' ';
  810.     field   7   value   '-------';
  811.     field   3   value   ' ';
  812.     byte        value   0;
  813. endrec;
  814.  
  815.     call    print.report.line;
  816.     call    print.report.line;
  817.     switch on type.of.sort:
  818.         'D',
  819.         'T': begin
  820.             switch on curr.report.type:
  821.                 'XRA',
  822.                 'TAP':begin
  823.                     move pr.hdg.1[string] to report.line;
  824.                     call print.report.line;
  825.                     move pr.hdg.2[string] to report.line;
  826.                     call print.report.line;
  827.                     end;
  828.                 'STI',
  829.                 'STO',
  830.                 'INV':    begin
  831.                     move pr.hdg.3[string] to report.line;
  832.                     call print.report.line;
  833.                     move pr.hdg.4[string] to report.line;
  834.                     call print.report.line;
  835.                     end;
  836.                 'CHM',
  837.                 'CHT': begin
  838.                     move pr.hdg.7[string] to report.line;
  839.                     call print.report.line;
  840.                     move pr.hdg.8[string] to report.line;
  841.                     call print.report.line;
  842.                      end;
  843.                 endswitch;
  844.             end;
  845.  
  846.         'M': begin
  847.             move pr.hdg.5[string] to report.line;
  848.             call print.report.line;
  849.             move pr.hdg.6[string] to report.line;
  850.             call print.report.line;
  851.             end;
  852.  
  853.         endswitch;
  854. end;
  855.  
  856. {------------------------------------------------------------------}
  857. procedure member.list:
  858. begin
  859.  
  860.     move 0 to sys.key;
  861.     read sys error standard;
  862.     move 0 to sort.in.key;
  863.     move 0 to sort.out.key;
  864.     move 'M' to type.of.sort;
  865.     move type.of.sort to csort.name.code;
  866.     open csort error standard;
  867.     call full.sort;
  868.     move 0 to csort.key;
  869.     read csort error standard;
  870.     move csort.nxt to wk.key.2;
  871.     move 1 to wk.key;
  872.  
  873.     move s.wide.printer to printer.to.select;
  874.     call select.printer;
  875.     call init.report;
  876.  
  877.     move s.name to heading.1;
  878.     move 'Membership List' to heading.2;
  879.  
  880.     while wk.key < wk.key.2 do
  881.         move wk.key to csort.key;
  882.         read csort error standard;
  883.         move csort.code.key to m.key;
  884.         read member error standard;
  885.  
  886.         if m.type = 'A' or m.type = 'L' then
  887.             call pr.member.list;
  888.             fi;
  889.  
  890.         add 1 to wk.key;
  891.         od;
  892.     call end.report;
  893.     close csort error standard;
  894. end;
  895. {-------------------------------------------------------------}
  896. procedure pr.member.list:
  897. begin
  898.  
  899.                                         redefine report.line;
  900.     field                       5;
  901.     field   pr.m.member.num     4;
  902.     field                       2;
  903.     field   pr.m.l.name         20;
  904.     field                       2;
  905.     field   pr.m.f.name         12;
  906.     field                       2;
  907.     field   pr.m.addr           30;
  908.     field                       2;
  909.     field   pr.m.city           20;
  910.     field                       2;
  911.     field   pr.m.state          2;
  912.     field                       2;
  913.     field   pr.m.zip            9;
  914.     field                       2;
  915.     field   pr.m.date.joined    8;
  916.     field                       4;
  917.     field   pr.m.type           1;
  918.     field                       3;
  919.                                         endredef;
  920.  
  921.     call justify.member.fields;
  922.     move m.member.num to pr.m.member.num;
  923.     move m.l.name to pr.m.l.name;
  924.     move m.f.name to pr.m.f.name;
  925.     move m.addr to pr.m.addr;
  926.     move m.city to pr.m.city;
  927.     move m.state to pr.m.state;
  928.     move m.zip to pr.m.zip;
  929.     move m.date.joined to pr.m.date.joined;
  930.     move m.type to pr.m.type;
  931.  
  932.     call print.report.line;
  933.  
  934. end;
  935.  
  936. {-------------------------------------------------------------}
  937. copy "MAIL-LBL.LIB";
  938. {-------------------------------------------------------------}
  939. procedure print.label:
  940. begin
  941.  
  942.     call get.label.specs;
  943.     move "L" to type.of.sort;
  944.     move 0 to sort.in.key;
  945.     move 0 to sort.out.key;
  946.     call full.sort;
  947. end;
  948. {-------------------------------------------------------------}
  949. {                 FULLSORT in/out routines                    }
  950. {-------------------------------------------------------------}
  951.  
  952. procedure sort.input:
  953. begin
  954.     add 1 to sort.in.key;
  955.     move sort.in.key to sort.key;
  956.     move 'Y' to sort.rec.present;
  957.     switch on type.of.sort;
  958.         'L',
  959.         'M': begin
  960.             if sort.in.key < s.m.nxt then
  961.                 move sort.in.key to m.key;
  962.                 read member error standard;
  963.                 call justify.member.fields;
  964.                 if type.of.sort = "L" then
  965.                     if inqlabel.life.annual = "E" then
  966.                         if m.type[byte] <> "A"
  967.                         and m.type[byte] <> "L" then
  968.                             move "E" to m.type[byte];
  969.                         fi; fi;
  970.                     if inqlabel.life.annual <> " "
  971.                     and inqlabel.life.annual <> m.type[byte] then
  972.                         goto sort.input;
  973.                         fi;
  974.                     if inqlabel.month.joined[word] <> "  "
  975.                     and inqlabel.month.joined[word] <> m.date.joined[word] then
  976.                         goto sort.input;
  977.                         fi;
  978.                     if inqlabel.year.joined[word] <> "  "
  979.                     and inqlabel.year.joined[word] <> m.date.joined[+6,word] then
  980.                         goto sort.input;
  981.                         fi;
  982.                     if m.l.name = " "
  983.                     and m.f.name = " " then
  984.                         goto sort.input;
  985.                         fi;
  986.                     move m.zip to wk.str;
  987.                     call trunc.wk.str;
  988.                 else
  989.                     move 0 to wk.str[byte];
  990.                     fi;
  991.                 move m.l.name to wk.str.2;
  992.                 append wk.str.2 to wk.str;
  993.                 call trunc.wk.str;
  994.                 move m.f.name to wk.str.2;
  995.                 append wk.str.2 to wk.str;
  996.                 move wk.str to sort.field;
  997.             else
  998.                 move 'N' to sort.rec.present;
  999.                 fi;
  1000.             end;
  1001.         'T': begin
  1002.             if sort.in.key < s.t.nxt then
  1003.                 move sort.in.key to t.key;
  1004.                 read tape error standard;
  1005.                 switch on curr.report.type:
  1006.                     'CHM',
  1007.                     'CHT': begin
  1008.                         switch on pr.sort.select:
  1009.                             'T': move t.title to sort.field;
  1010.                             'M': begin
  1011.                                  move t.member.num to wk.str;
  1012.                                  justify wk.str right
  1013.                                     length ##t.member.num;
  1014.                                  move wk.str to sort.field;
  1015.                                  end;
  1016.                             endswitch;
  1017.                          end;
  1018.  
  1019.                     'INV',
  1020.                     'TAP',
  1021.                     'XRA': move t.title to sort.field;
  1022.                     endswitch;
  1023. {*debug*        convert sort.key to wk.str;
  1024. {*debug*        display "IN sort.key = ",wk.str,;
  1025. {*debug*        move sort.field to wk.str;
  1026. {*debug*        display "   Field = ",wk.str;
  1027.             else
  1028.                 move 'N' to sort.rec.present;
  1029.                 fi;
  1030.             end;
  1031.         "D": begin
  1032.             if sort.key >= s.t.nxt then
  1033.                 move "N" to sort.rec.present;
  1034.             else
  1035.                 move sort.in.key to t.key;
  1036.                 read tape error standard;
  1037.                 switch on curr.report.type:
  1038.                     "STI":  move t.date.in.stock    to wk.str;
  1039.                     "STO":  move t.date.out.stock   to wk.str;
  1040.                     endswitch;
  1041.                 move wk.str[+6,word]    to sort.field[+0,word]; {year}
  1042.                 move wk.str[+0,word]    to sort.field[+2,word]; {month}
  1043.                 move wk.str[+3,word]    to sort.field[+4,word]; {day}
  1044.                 move t.stock.num        to sort.field[+6, field, length 4];
  1045.                 move 0                  to sort.field[+10,byte];
  1046.                 fi;
  1047.             end;
  1048.         endswitch;
  1049.     end;
  1050.  
  1051. {-------------------}
  1052. procedure sort.output:
  1053. begin
  1054.     switch on type.of.sort:
  1055.         "L": begin
  1056.             if sort.rec.present = "Y" then
  1057.                 move sort.key to m.key;
  1058.                 call process.this.member;
  1059.             else
  1060.                 if inqlabel.num.wide = "D"
  1061.                 and disk.out.open = "Y" then
  1062.                     call print.all.labels;
  1063.                     move "Y" to end.report.inhibit.form.feed;
  1064.                     close disk.out error standard;
  1065.                     fi;
  1066.                 call end.report;
  1067.                 fi;
  1068.             exit;
  1069.             end;
  1070.         "D",
  1071.         "M",
  1072.         "T": begin
  1073.             add 1 to sort.out.key;
  1074.             move sort.out.key to csort.key;
  1075.             if sort.rec.present = 'Y' then
  1076. {*debug*        convert sort.key to wk.str;
  1077. {*debug*        display "OUT sort.key = ",wk.str,;
  1078. {*debug*        move sort.field to wk.str;
  1079. {*debug*        display "   Field = ",wk.str;
  1080.                 move sort.rec to csort.rec;
  1081.                 write csort error standard;
  1082.             else
  1083.                 move 0 to csort.key;
  1084.                 move sort.out.key to csort.nxt;
  1085.                 write csort error standard;
  1086.                 fi;
  1087.             end;
  1088.         endswitch;
  1089. end;
  1090. {----------------------------------------------------------------}
  1091. procedure cmp.date:
  1092. begin
  1093.  
  1094.     move ' ' to cmp.date.result;
  1095.     move cmp.date.1 to wk.str;
  1096.     call trunc.wk.str;
  1097.     move wk.str to cmp.date.1;
  1098.     move cmp.date.2 to wk.str;
  1099.     call trunc.wk.str;
  1100.     move wk.str to cmp.date.2;
  1101.     if cmp.date.1 = '' or cmp.date.2 = '' then exit fi;
  1102.     if cmp.date.1 = cmp.date.2 then 
  1103.         move '=' to cmp.date.result;
  1104.         exit;
  1105.         fi;
  1106.     move '<' to cmp.date.result;
  1107.     if cmp.date.1[+6,field length 2] > cmp.date.2[+6,field length 2] then
  1108.         move '>' to cmp.date.result;
  1109.         exit;
  1110.         fi;
  1111.     if  cmp.date.1[+0,field length 2] > cmp.date.2[+0,field length 2]
  1112.     and cmp.date.1[+6,field length 2] = cmp.date.2[+6,field length 2] then
  1113.         move '>' to cmp.date.result;
  1114.         exit;
  1115.         fi;
  1116.     if  cmp.date.1[+3,field length 2] > cmp.date.2[+3, field length 2]
  1117.     and cmp.date.1[+0,field length 2] = cmp.date.2[+0,field length 2] then
  1118.         move '>' to cmp.date.result;
  1119.         fi;
  1120. end;
  1121.  
  1122. {----------------------------------------------------------------
  1123. {       M A I N     P R O G R A M
  1124. {----------------------------------------------------------------
  1125.  
  1126.                                         redefine screen.data;
  1127. record  menu;
  1128.     field   menu.version    3;
  1129.     field   menu.date       8;
  1130.     field   menu.option     2;
  1131.     endrec;
  1132.                                         endredef;
  1133.  
  1134.  
  1135.  
  1136.     move IPC.area to startup.parms[string] length ##startup.parms;
  1137.     if todays.date[+2,byte] <> "/"
  1138.     or todays.date[+5,byte] <> "/" then
  1139.         display "Invalid program startup";
  1140.         goto end;
  1141.         fi;
  1142.     move data.ext to sys.file.ext;
  1143.     move data.ext to m.file.ext;
  1144.     move data.ext to t.file.ext;
  1145.     move data.ext to tscan.file.ext;
  1146.     move data.ext to mscan.file.ext;
  1147.  
  1148.     move my.terminal.type to terminal.type;
  1149.  
  1150.     move 'VIDSCREN.DAT' to screen.file.name;
  1151.  
  1152.     open sys error standard;
  1153.  
  1154.     move 0 to sys.key;
  1155.     read sys error standard;
  1156.  
  1157.     open member error standard;
  1158.     open tape error standard;
  1159.     open tapescan error standard;
  1160.     open memscan error standard;
  1161. report.exit:
  1162.     do
  1163.         move 0 to sys.key;
  1164.         read sys error standard;
  1165.         move s.date to menu.date;
  1166.         move '1.0' to menu.version;
  1167. menu.get.data:
  1168.         fill menu.option with ' ';
  1169.         move 'menu' to screen.name;
  1170.         call get.screen.data;
  1171.         move s.date to menu.date;
  1172.         switch on menu.option[word]:
  1173.             'AM':    call add.member;
  1174.             'CM':    call change.member;
  1175.             'AT':    call add.tape;
  1176.             'CT':    call change.tape;
  1177.             'CK':    call check.tape;
  1178.             'EX':    exitdo;
  1179.             'PR':    call printing.menu;
  1180.             'PL':    call print.label;
  1181.             'SP':    call printer.set.up;
  1182.             else begin
  1183.                 move 'invalid option' to status.line;
  1184.                 call status.line.display;
  1185.                 goto menu.get.data;
  1186.                 end;
  1187.             endswitch;
  1188.         od;
  1189.     close sys error standard;
  1190.     close member error standard;
  1191.     close tape error standard;
  1192.     close tapescan error standard;
  1193.     close memscan error standard;
  1194. end;
  1195.