contrib/forms/formmaker/formscript.pl

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use CGI qw(:standard);
   7
   8 #file templates here
   9
  10 #documentation
  11 my $documentation =<<'START';
  12
  13 *************************************
  14 *      Form Generating Script 1.1   *
  15 *************************************
  16
  17 This is a complete rewrite of an earlier Perl script I wrote to generate
  18 forms for OpenEMR.  It is now all self contained within a single .pl file.
  19 To run at the shell command line, type:
  20
  21 Perl formscript.pl [filename]
  22
  23 where filename is a text file with data relating to your form.  If you run
  24 without a filename argument, a sample data file will be created in the same
  25 directory named 'sample.txt' that you can use to see how to create your own.
  26
  27 Basically you enter one database field item per line like this:
  28
  29 Social History::popup_menu::smoker::non-smoker
  30
  31 or
  32
  33 Social History::radio_group::smoker::non-smoker
  34
  35
  36 where the first item is the field name.  spaces within the name will convert to '_'
  37 for the sql database field name.  If you use a SQL reserved word, the form generation
  38 will fail and this program will notify you of the word(s) you used.
  39
  40 The '::' is the standard delimiter that I use between items.  The second item on the line
  41 is the form widget type.  You can choose from:
  42
  43 textfield
  44 textarea
  45 checkbox
  46 checkbox_group
  47 radio_group
  48 popup_menu
  49 scrolling_list
  50 scrolling_list_multiples
  51
  52 Putting a '+' at the beginning of the field name will let the form know that you want to
  53 report negatives.  This means the following:
  54
  55 +cardiac_review::checkbox_group::chest pain::shortness of breath::palpitations
  56
  57 creates a group of checkboxes where if the user chooses the first two boxes, the database will
  58 have the following line entered:
  59
  60 chest pain, shortness of breath.  Negative for palpitations.
  61
  62 The remaining items after the fieldname and the widget type  are the names for
  63 checkboxes or radio buttons or default text
  64 for a textfield or text area.  You can also start a line with a '#' as the first character and this
  65 will be an ignored comment line.  If you put html tags on their own lines, they will be integrated
  66 into the form.  It will be most helpful to look at 'sample.txt' to see how this works.
  67
  68 This is 1.1 and is tested to the extent of installing the form and entering data within an encounter.
  69 Please send feedback to mail@doc99.com.  I will definitely
  70 be fixing and improving it.
  71
  72 Mark Leeds
  73
  74
  75 START
  76
  77 #info.txt
  78 my $info_txt=<<'START';
  79 FORM_NAME
  80 START
  81
  82 #new.php
  83 my $new_php =<<'START';
  84 <?php
  85 include_once("../../globals.php");
  86 include_once("$srcdir/api.inc");
  87 formHeader("Form: FORM_NAME");
  88 ?>
  89 <html><head>
  90 <link rel=stylesheet href="<?echo $css_header;?>" type="text/css">
  91 </head>
  92 <body <?echo $top_bg_line;?> topmargin=0 rightmargin=0 leftmargin=2 bottommargin=0 marginwidth=2 marginheight=0>
  93 <form method=post action="<?echo $rootdir;?>/forms/FORM_NAME/save.php?mode=new" name="FORM_NAME">
  94 <hr>
  95 <h1> FORM_NAME </h1>
  96 <hr>
  97 DATABASEFIELDS
  98 </form>
  99 <?php
 100 formFooter();
 101 ?>
 102 START
 103
 104 #print.php
 105 my $print_php=<<'START';
 106 <?php
 107 include_once("../../globals.php");
 108 include_once("$srcdir/api.inc");
 109 formHeader("Form: FORM_NAME");
 110 ?>
 111 <html><head>
 112 <link rel=stylesheet href="<?echo $css_header;?>" type="text/css">
 113 </head>
 114 <body <?echo $top_bg_line;?> topmargin=0 rightmargin=0 leftmargin=2 bottommargin=0 marginwidth=2 marginheight=0>
 115 <form method=post action="<?echo $rootdir;?>/forms/FORM_NAME/save.php?mode=new" name="my_form">
 116 <h1> FORM_NAME </h1>
 117 <hr>
 118 DATABASEFIELDS
 119 </form>
 120 <?php
 121 formFooter();
 122 ?>
 123 START
 124
 125 #report.php
 126 my $report_php=<<'START';
 127 <?php
 128 //------------report.php
 129 include_once("../../globals.php");
 130 include_once($GLOBALS["srcdir"]."/api.inc");
 131 function FORM_NAME_report( $pid, $encounter, $cols, $id) {
 132 $count = 0;
 133 $data = formFetch("form_FORM_NAME", $id);
 134 if ($data) {
 135 print "<table><tr>";
 136 foreach($data as $key => $value) {
 137 if ($key == "id" || $key == "pid" || $key == "user" || $key == "groupname" || $key == "authorized" || $key == "activity" || $key == "date" || $value == "" || $value == "0000-00-00 00:00:00") {
 138         continue;
 139 }
 140 if ($value == "on") {
 141 $value = "yes";
 142 }
 143 $key=ucwords(str_replace("_"," ",$key));
 144 print "<td><span class=bold>$key: </span><span class=text>$value</span></td>";
 145 $count++;
 146 if ($count == $cols) {
 147 $count = 0;
 148 print "</tr><tr>\n";
 149 }
 150 }
 151 }
 152 print "</tr></table>";
 153 }
 154 ?>
 155 START
 156
 157 #save.php
 158 my $save_php=<<'START';
 159 <?php
 160 //------------This file inserts your field data into the MySQL database
 161 include_once("../../globals.php");
 162 include_once("$srcdir/api.inc");
 163 include_once("$srcdir/forms.inc");
 164
 165 //process form variables here
 166 //create an array of all of the existing field names
 167 $field_names = array(FIELDNAMES);
 168 $negatives = array(NEGATIVES);
 169 //process each field according to it's type
 170 foreach($field_names as $key=>$val)
 171 {
 172         if ($val == "checkbox")
 173         {
 174                 if ($_POST[$key]) {$field_names[$key] = "positve";}
 175                 else {$field_names[$key] = "negative";}
 176         }
 177         elseif (($val == "checkbox_group")||($val == "scrolling_list_multiples"))
 178         {
 179                 $neg = '';
 180                 if (array_key_exists($key,$negatives)) #a field requests reporting of negatives
 181                 {
 182                         foreach($_POST[$key] as $pos) #check positives against list
 183                         {
 184                                 if (array_key_exists($pos, $negatives[$key]))
 185                                 {       #remove positives from list, leaving negatives
 186                                         unset($negatives[$key][$pos]);
 187                                 }
 188                         }
 189                         $neg = ".   Negative for ".implode(', ',$negatives[$key]);
 190                 }
 191                 $field_names[$key] = implode(', ',$_POST[$key]).$neg;
 192         }
 193         else
 194         {
 195                 $field_names[$key] = $_POST[$key];
 196         }
 197 }
 198
 199 //end special processing
 200
 201 foreach ($field_names as $k => $var) {
 202 $field_names[$k] = mysql_escape_string($var);
 203 echo "$var\n";
 204 }
 205 if ($encounter == "")
 206 $encounter = date("Ymd");
 207 if ($_GET["mode"] == "new"){
 208 $newid = formSubmit("form_FORM_NAME", $field_names, $_GET["id"], $userauthorized);
 209 addForm($encounter, "FORM_NAME", $newid, "FORM_NAME", $pid, $userauthorized);
 210 }elseif ($_GET["mode"] == "update") {
 211
 212
 213 sqlInsert("update form_FORM_NAME set pid = {$_SESSION["pid"]},groupname='".$_SESSION["authProvider"]."',user='".$_SESSION["authUser"]."',authorized=$userauthorized,activity=1, date = NOW(), FIELDS where id=$id");
 214 }
 215 $_SESSION["encounter"] = $encounter;
 216 formHeader("Redirecting....");
 217 formJump();
 218 formFooter();
 219 ?>
 220 START
 221
 222 #table.sql
 223 my $table_sql=<<'START';
 224 CREATE TABLE IF NOT EXISTS `form_FORM_NAME` (
 225 id bigint(20) NOT NULL auto_increment,
 226 date datetime default NULL,
 227 pid bigint(20) default NULL,
 228 user varchar(255) default NULL,
 229 groupname varchar(255) default NULL,
 230 authorized tinyint(4) default NULL,
 231 activity tinyint(4) default NULL,
 232 DATABASEFIELDS
 233 PRIMARY KEY (id)
 234 ) TYPE=MyISAM;
 235 START
 236
 237 #view.php
 238 my $view_php =<<'START';
 239 <!-- view.php -->
 240 <?php
 241 include_once("../../globals.php");
 242 include_once("$srcdir/api.inc");
 243 formHeader("Form: FORM_NAME");
 244 ?>
 245 <html><head>
 246 <link rel=stylesheet href="<?echo $css_header;?>" type="text/css">
 247 </head>
 248 <body <?echo $top_bg_line;?> topmargin=0 rightmargin=0 leftmargin=2 bottommargin=0 marginwidth=2 marginheight=0>
 249 <form method=post action="<?echo $rootdir?>/forms/FORM_NAME/save.php?mode=update&id=<?echo $_GET["id"];?>" name="my_form">
 250 <h1> FORM_NAME </h1>
 251 <hr>
 252 DATABASEFIELDS
 253
 254 </form>
 255 <?php
 256 formFooter();
 257 ?>
 258 START
 259
 260 #preview.html
 261 my $preview_html =<<'START';
 262 <html><head>
 263 </head>
 264 <body>
 265 <form>
 266 <hr>
 267 <h1> FORM_NAME </h1>
 268 <hr>
 269 DATABASEFIELDS
 270 </form>
 271 </body>
 272 </html>
 273 START
 274
 275 #sample.txt
 276 my $sample_txt =<<'START';
 277 a1_preop_physical
 278
 279 chief_complaints::textarea
 280
 281 <h3>past surgical history</h3>
 282 +surgical history::checkbox_group::cholecystectomy::tonsillectomy::apendectomy
 283 <h4>other</h4>
 284 surgical history other::textfield
 285
 286 <h3>past surgical history</h3>
 287 +medical history::scrolling_list_multiples::asthma::diabetes::hypertension
 288 <h4>other</h4>
 289 medical history other::textfield
 290
 291 <h2>Allergies</h2>
 292 +allergies::checkbox_group::penicillin::sulfa::iodine
 293 <h4>other</h4>
 294 allergies other::textfield
 295
 296 <h2>Social History</h2>
 297 <h3>smoking</h3>
 298 smoke history::radio_group::non-smoker::smoker
 299 <h3>alcohol</h3>
 300 etoh history::scrolling_list::none::occasional::daily::heavy use
 301 START
 302
 303 my @reserved = ('ADD','ALL','ALTER','ANALYZE','AND','AS','ASC','ASENSITIVE','BEFORE','BETWEEN','BIGINT','BINARY','BLOB','BOTH','BY','CALL','CASCADE','CASE','CHANGE','CHAR','CHARACTER','CHECK','COLLATE','COLUMN','CONDITION','CONNECTION','CONSTRAINT','CONTINUE','CONVERT','CREATE','CROSS','CURRENT_DATE','CURRENT_TIME','CURRENT_TIMESTAMP','CURRENT_USER','CURSOR','DATABASE','DATABASES','DAY_HOUR','DAY_MICROSECOND','DAY_MINUTE','DAY_SECOND','DEC','DECIMAL','DECLARE','DEFAULT','DELAYED','DELETE','DESC','DESCRIBE','DETERMINISTIC','DISTINCT','DISTINCTROW','DIV','DOUBLE','DROP','DUAL','EACH','ELSE','ELSEIF','ENCLOSED','ESCAPED','EXISTS','EXIT','EXPLAIN','FALSE','FETCH','FLOAT','FOR','FORCE','FOREIGN','FROM','FULLTEXT','GOTO','GRANT','GROUP','HAVING','HIGH_PRIORITY','HOUR_MICROSECOND','HOUR_MINUTE','HOUR_SECOND','IF','IGNORE','IN','INDEX','INFILE','INNER','INOUT','INSENSITIVE','INSERT','INT','INTEGER','INTERVAL','INTO','IS','ITERATE','JOIN','KEY','KEYS','KILL','LEADING','LEAVE','LEFT','LIKE','LIMIT','LINES','LOAD','LOCALTIME','LOCALTIMESTAMP','LOCK','LONG','LONGBLOB','LONGTEXT','LOOP','LOW_PRIORITY','MATCH','MEDIUMBLOB','MEDIUMINT','MEDIUMTEXT','MIDDLEINT','MINUTE_MICROSECOND','MINUTE_SECOND','MOD','MODIFIES','NATURAL','NOT','NO_WRITE_TO_BINLOG','NULL','NUMERIC','ON','OPTIMIZE','OPTION','OPTIONALLY','OR','ORDER','OUT','OUTER','OUTFILE','PRECISION','PRIMARY','PROCEDURE','PURGE','READ','READS','REAL','REFERENCES','REGEXP','RENAME','REPEAT','REPLACE','REQUIRE','RESTRICT','RETURN','REVOKE','RIGHT','RLIKE','SCHEMA','SCHEMAS','SECOND_MICROSECOND','SELECT','SENSITIVE','SEPARATOR','SET','SHOW','SMALLINT','SONAME','SPATIAL','SPECIFIC','SQL','SQLEXCEPTION','SQLSTATE','SQLWARNING','SQL_BIG_RESULT','SQL_CALC_FOUND_ROWS','SQL_SMALL_RESULT','SSL','STARTING','STRAIGHT_JOIN','TABLE','TERMINATED','THEN','TINYBLOB','TINYINT','TINYTEXT','TO','TRAILING','TRIGGER','TRUE','UNDO','UNION','UNIQUE','UNLOCK','UNSIGNED','UPDATE','USAGE','USE','USING','UTC_DATE','UTC_TIME','UTC_TIMESTAMP','VALUES','VARBINARY','VARCHAR','VARCHARACTER','VARYING','WHEN','WHERE','WHILE','WITH','WRITE','XOR','YEAR_MONTH','ZEROFILL','ACTION','BIT','DATE','ENUM','NO','TEXT','TIME','TIMESTAMP');
 304 my %reserved;
 305 $reserved{$_}++ for @reserved;
 306
 307 #main program
 308
 309 if (@ARGV == 0)
 310 {
 311         to_file('sample.txt',$sample_txt) if not -f 'sample.txt';
 312         print $documentation."\n";
 313         exit 0;
 314 }
 315
 316 my $form_name = <>;
 317 chomp($form_name);
 318 if ($reserved{$form_name})
 319 {
 320         print "You have chosen an SQL reserved word for your form name: $form_name.  Please try again.\n";
 321         exit 1;
 322 }
 323 $form_name =~ s/^\s+(\S)\s+$/$1/;
 324 $form_name =~ s/\s+/_/g;
 325 if (not -d $form_name)
 326 {
 327         mkdir "$form_name" or die "Could not create directory $form_name: $!";
 328 }
 329 my @field_data; #the very important array of field data
 330 chomp, push @field_data, [ split /::/ ] while <>;
 331 my %negatives; #key=field name: these are the fields that require reporting of pertinant
 332                 #negatives.  will only apply to checkbox_group and scrolling_list_multiples types
 333 my @reserved_used;
 334 #strip outer spaces from field names and field types and change inner spaces to underscores
 335 #and check field names for SQL reserved words now
 336 for (@field_data)
 337 {
 338         if ($_->[0] and $_->[1])
 339         {
 340                 $_->[0] =~ s/^\s+(\S)\s+$/$1/;
 341                 $_->[0] =~ s/\s+/_/g;
 342                 push @reserved_used, $_->[0] if $reserved{$_->[0]};
 343                 $_->[1] =~ s/^\s+(\S)\s+$/$1/;
 344                 if ($_->[0] =~ /^\+/) #a leading '+' indicates to print negatives
 345                 {               # or not checked values in a checkbox_group or scrolling_list_multiples
 346                         $_->[0] =~ s/^\+(.*)/$1/;
 347                         $negatives{$_->[0]}++;
 348                 }
 349         }
 350 }
 351 if (@reserved_used)
 352 {
 353         print "You have chosen the following reserved words as field names.  Please try again.\n";
 354         print "$_\n" for @reserved_used;
 355         exit 1;
 356 }
 357
 358 my $text = make_form(@field_data);
 359 my $out;
 360
 361 #info.txt
 362 $out = replace($info_txt, 'FORM_NAME', $form_name);
 363 to_file("$form_name/info.txt",$out);
 364
 365 #new.php
 366 $out = replace($new_php, 'FORM_NAME', $form_name);
 367 $out = replace($out, 'DATABASEFIELDS', $text);
 368 to_file("$form_name/new.php",$out);
 369
 370 #print.php
 371 $out = replace($print_php, 'FORM_NAME', $form_name);
 372 $out = replace($out, 'DATABASEFIELDS', $text);
 373 to_file("$form_name/print.php",$out);
 374
 375 #report.php
 376 $out = replace($report_php, 'FORM_NAME', $form_name);
 377 $out = replace($out, 'DATABASEFIELDS', $text);
 378 to_file("$form_name/report.php",$out);
 379
 380 #save.php
 381 $out = replace($save_php, 'FORM_NAME', $form_name);
 382 $out = replace_save_php($out, @field_data);
 383 to_file("$form_name/save.php",$out);
 384
 385 #view.php
 386 $out = replace($view_php, 'FORM_NAME', $form_name);
 387 $out = replace($out, 'DATABASEFIELDS', $text);
 388 to_file("$form_name/view.php",$out);
 389
 390 #table.sql
 391 $out = replace($table_sql, 'FORM_NAME', $form_name);
 392 $out = replace_sql($out, @field_data);
 393 to_file("$form_name/table.sql",$out);
 394
 395 #preview.html
 396 $out = replace($preview_html, 'FORM_NAME', $form_name);
 397 $out = replace($out, 'DATABASEFIELDS', $text);
 398 to_file("$form_name/preview.html",$out);
 399
 400 # subs
 401
 402 sub replace
 403 {
 404         my $text = shift;
 405         my %words = @_;
 406         $text =~ s/$_/$words{$_}/g for keys %words;
 407         return $text;
 408 }
 409
 410
 411 sub replace_save_php #a special case
 412 {
 413         my $text = shift;
 414         my @fields = map {$_->[0]} grep{$_->[0] and $_->[1]} @_;
 415         for (@fields)
 416         {
 417                  $_ = "$_='\".\$field_names[\"$_\"].\"'";
 418         }
 419         my $fields = join ',',@fields;
 420         $text =~ s/FIELDS/$fields/;
 421         @fields = ();
 422         my @negatives;
 423         for (@_)
 424         {
 425                 if ($_->[0] and $_->[1])
 426                 {
 427                         push @fields, "'$_->[0]' => '$_->[1]'";
 428                         if ($negatives{$_->[0]})
 429                         {
 430                                 my @temp;
 431                                 my $count = 2;
 432                                 while ($count < scalar(@$_))
 433                                 {
 434                                         push @temp, "'$_->[$count]' => '$_->[$count]'";
 435                                         $count++;
 436                                 }
 437                                 push @negatives, "'$_->[0]' => array(".join(', ', @temp).")";
 438                         }
 439                 }
 440         }
 441         $fields = join ', ', @fields;
 442         $text =~ s/FIELDNAMES/$fields/;
 443         my $negatives = join ', ', @negatives;
 444         $text =~ s/NEGATIVES/$negatives/;
 445         return $text;
 446 }
 447
 448 sub replace_sql #a special case
 449 {
 450         my $text = shift;
 451         my @fields = map {$_->[0]} grep{$_->[0] and $_->[1]} @_;
 452         my $replace = '';
 453         $replace .= "$_ TEXT,\n" for @fields;
 454         $text =~ s/DATABASEFIELDS/$replace/;
 455         return $text;
 456 }
 457
 458 sub make_form
 459 {
 460         my @data = @_;
 461         my $return = submit(-name=>'submit form');
 462         $return .= "<table>";
 463         for (@data)
 464         {
 465                 next if not $_->[0];
 466                 next if $_->[0] =~ /^#/; #ignore perl type comments
 467                 if ($_->[0] =~ /^\w/ and $_->[1])
 468                 {
 469                         my $field_name = shift @$_;
 470                         my $field_type = shift @$_;
 471                         my $label = $field_name;
 472                         $label =~ s/_/ /g;
 473                         if ($field_type =~ /^textfield$/)
 474                         {
 475                                 $return .= Tr(td($label),td(textfield(-name=>$field_name, -value=> join @$_)))."\n";
 476                         }
 477                         elsif ($field_type =~ /^textarea$/)
 478                         {
 479                                 $return .= Tr(td($label),td(textarea(-name=>$field_name, -rows=>4, -columns=>40, -value=> join @$_)))."\n";
 480                         }
 481                         elsif ($field_type =~ /^radio_group$/)
 482                         {
 483                                 $return .= Tr(td($label),td(radio_group(-name=>$field_name, -values=>$_)))."\n";;
 484                         }
 485                         elsif ($field_type =~ /^checkbox$/)
 486                         {
 487                                 $return .= Tr(td($label),td(checkbox(-name=>$field_name, -value=>'yes', -label=> join @$_)))."\n";
 488                         }
 489                         elsif ($field_type =~ /^checkbox_group$/)
 490                         {
 491                                 $return .= Tr(td($label),td(checkbox_group(-name=>$field_name.'[]', -values=>$_)))."\n";
 492                         }
 493                         elsif ($field_type =~ /^popup_menu/)
 494                         {
 495                                 $return .= Tr(td($label),td(popup_menu(-name=>$field_name, -values=>$_)))."\n";
 496                         }
 497                         elsif ($field_type =~ /^scrolling_list/)
 498                         {
 499                                 my $mult = 'false';
 500                                 my $mult2 = '';
 501                                 $mult = 'true' if $field_type =~ /multiples$/;
 502                                 $mult2 = '[]' if $field_type =~ /multiples$/;
 503                                 $return .= Tr(td($label),td(scrolling_list(-name=>$field_name.$mult2, -values=>$_, -size=>scalar(@$_), -multiple=>$mult)))."\n";
 504                         }
 505                 unshift @$_, $field_type;
 506                 unshift @$_, $field_name;
 507                 }
 508                 else #probably an html tag or something
 509                 {
 510                         $return .= "</table>";
 511                         $return .= $_->[0]."\n";
 512                         $return .= "<table>";
 513                 }
 514         }
 515         $return .= "<table>";
 516         $return .= submit(-name=>'submit form');
 517         return $return;
 518 }
 519
 520 sub to_file
 521 {
 522         my $filename = shift;
 523         my $string = shift;
 524         my $file;
 525         open $file, '>', $filename or die "cannot open $filename: $!";
 526         print $file $string;
 527         close $file or die "cannot close $filename: $!";
 528 }