home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol094 / terms.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1984-04-29  |  5.4 KB  |  181 lines
  1. program terms(0);
  2. {$c-}
  3. {$m-}
  4. {$f-}
  5. {$R-}
  6. {$u-}
  7. {program to maintain file of terms for diagnosis            }
  8. {last revision: 8/11/82                            }
  9.  
  10.  
  11.  
  12. {COPYRIGHT 1982 (C) BY CRAIG RUDLIN, M.D.  ALL RIGHTS RESERVED.        }
  13.  
  14.  
  15.  
  16.  
  17.  
  18.  
  19.  
  20. {This program establishes a file of terms and their associated code, for use}
  21. {in encoding the patient's diagnoses.  The program establishes two files:   }
  22. {1- file arranged by term   and  2- file arranged by code                }
  23. {Each file is organized as a binary tree to facilitate location of the term}
  24. {or code, without having to maintain the file in alphabetical or numerical }
  25. {order, respectively.  Hence it is VERY IMPORTANT that both the terms and  }
  26. {their assigned codes are COMPLETELY RANDOMIZED --if they are not, the tree }
  27. {degenerates into a linked list, which must be searched sequentially...very }
  28. {slow!  The program allows for synonyms to have the same code, but does not }
  29. {allow the same term to be entered into the file more than once.  Because   }
  30. {synonyms are permitted, each code must be checked, and the user informed if}
  31. {it has been used previously. The user may then enter a different code, or  }
  32. {approve the use of the same code.  The program as written allows for 32K   }
  33. {terms -- the limit is due to the fact that pascal z must use an integer as }
  34. {the record number in a file, and the maximum integer is 32K.              }
  35.  
  36.  
  37. {As written, the program searches the file of codes each time a new term is }
  38. {entered, to insure that the code has not been used previously (and if so,  }
  39. {that it is ok to use it again).  Obviously, this is slower than creating an}
  40. {array of the codes used thus far, maintaining this array as a file on disk }
  41. {reading it into memory at the beginning of the program, and updating the   }
  42. {array and disk file, whenever changes are made.  This more expedient proce-}
  43. {dure was not adopted in this version for two reasons: 1- it limits the size}
  44. {of the term file to 9600 terms, because the maximum size of an array in    }
  45. {Pascal Z is 32K;  2- this program is written to run under both CP/M and MP/M}
  46. {MP/M does not permit more than 48K of TPA per user.  Hence, under certain  }
  47. {situations, the use of the array might cause the program to be too large for}
  48. {MP/M.  I recommend that if you are planning to use the program only with   }
  49. {CP/M, and to have more than several hundred terms, but not more than 9600  }
  50. {that you define the following types and vars and use the array:        }
  51.  
  52. {types: xnumbers: record code:array[1..128] of integer; end;
  53.         fxnumbers:file of xnumbers;
  54.  
  55.  var    fnumbers:fxnumbers;
  56.     numbers :xnumbers;
  57.     findcode: array[1..9600] of integer;                   }
  58.  
  59.  
  60. {--------------------------------------------------------------------------}
  61.  
  62. label 1;
  63.  
  64. const
  65. ucase = true;
  66. lower_case = false;
  67. letters_only = true;
  68. alphanumeric = false;
  69.  
  70.  
  71. type
  72.  
  73. byte = 0..255;
  74. $string80 = string 80;
  75.  
  76. char20 =  array[1..20] of char;
  77. char21 =  array[1..21] of char;
  78. char10 =  array[1..10] of char;
  79. char28 =  array[1..28] of char;
  80. char30 =  array[1..30] of char;
  81. char6  =  array[1..6]  of char;
  82. char4  =  array[1..4]  of char;
  83. char2  =  array[1..2]  of char;
  84. data   =  array[1..80] of char;
  85.  
  86. XTERMS =    RECORD
  87.         TERM:     char21;
  88.         code:    real;
  89.         LEFT:    INTEGER;   {pointers for tree}
  90.         RIGHT:  INTEGER;
  91.         PARENT: INTEGER;
  92.         PRINT_FLAG: BOOLEAN;
  93.         end;
  94.  
  95. FXTERMS = FILE OF XTERMS;
  96.  
  97.  
  98. xtest_units = (fake,NONE,OTHER,UGMS_DL,MGS_DL,MEQ_L,IU,PER_CC,
  99.         MG_24_HR,GM_24_HR,MG_KG,GM,ML_MIN,CELLS_CC,UNITS_ML,
  100.            NGMS_ML,UUNIT_ML,NGMS_DL,PGMS_ML,MEQ_ML,MICRO_IU,
  101.            NGM_ML_HR,ML,MG_TV,MUNITS_ML);
  102.  
  103.  
  104. {currently there are 25 possible units}
  105.  
  106.  
  107.  
  108. var {*******}
  109.  
  110. assigned_units:xtest_units;
  111.  
  112. fnumterms,FTERMS:FXTERMS;
  113. newterms,TERMS:XTERMS;
  114.  
  115.  
  116. recursive,found,terminate,end_of_field,end_of_input,end_of_record:boolean;
  117.  
  118. needs_units,error:boolean;
  119.  
  120. last_rec,reference_number:integer; {passes record number between procedures}
  121.  
  122. blanks: data;
  123.  
  124. numrecs:integer;
  125.  
  126. b:byte;
  127. command_line:array[1..80] of char;
  128.  
  129. num_file,term_file:array[1..12] of char;
  130.  
  131.  
  132. {***************** external procedures and functions *****************} 
  133.  
  134. procedure clear_screen;external;
  135. procedure move_cursor(x,y:byte);external;
  136. procedure erase_lines(starting_line,number_of_lines:byte);external;
  137. procedure prompt(x,y,length:byte;P:$string80;
  138.              protected_field_desired:boolean);external;
  139. procedure keyin(var cix:char);external;
  140. procedure menu;external;
  141. procedure add(change,numfile:boolean);external;
  142. procedure change;external;
  143. procedure delete(change,numfile:boolean);external;
  144. procedure find(code:boolean;flag:byte);external; 
  145. procedure show_information(hardcopy:boolean);external;
  146. procedure get_info(new:boolean);external;
  147.  
  148. procedure check_code(new:boolean;xcode:real;recno:integer);external;
  149. procedure initialize;external;
  150.  
  151. procedure search(recno:integer;key:real;key1:char21;delete:boolean);external;
  152.  
  153. procedure print_terms(hardcopy:boolean);external;
  154.  
  155. procedure make_file_name;external;
  156. procedure get_file(invalid:boolean);external;
  157. function  xvalid:boolean;external;
  158.  
  159. function query(x,y:byte;message:$string80):boolean;external;
  160. function input(x,y,len:byte;xucase,xletters_only:boolean;field:data):data;
  161.      external;
  162. function password:boolean;external;
  163.  
  164.  
  165. function realtoarray(number:real):data;external;
  166. function arraytoreal(field:data):real;external;
  167.  
  168. {*************************  main program *****************************}
  169. begin
  170.  
  171. {password; debug--leave out until installed in mpm}
  172.  
  173. terminate:=false;
  174.  
  175. initialize;
  176.  
  177. while terminate = false do menu;
  178.  
  179. end.
  180.  
  181.