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.2       *
  15 *******************************************
  16
  17 new for 1.1.2
  18
  19 Added a 'do not save' link at the top and bottom of the form.
  20 Fixed problem with using single and double quotes in input file.
  21 Changed deprecated PHP function mysql_escape_string to
  22 mysql_real_escape_string.
  23
  24 bugs: There may still be a problem with reserved MySQL words not
  25 being caught.  There may be other bugs not discovered yet.
  26
  27 future plans: I plan on improving the output format in report.php.
  28 For now, users can alter this form as needed.  Since formscript.pl
  29 knows the fields to be used, it makes more sense to list them
  30 explicitly than to print them in a foreach loop.  I will get to
  31 work on this soon.
  32
  33 1.1
  34
  35 This is a complete rewrite of an earlier Perl script I wrote to generate
  36 forms for OpenEMR.  It is now all self contained within a single .pl file.
  37 To run at the shell command line, type:
  38
  39 Perl formscript.pl [filename]
  40
  41 where filename is a text file with data relating to your form.  If you run
  42 without a filename argument, a sample data file will be created in the same
  43 directory named 'sample.txt' that you can use to see how to create your own.
  44
  45 Basically you enter one database field item per line like this:
  46
  47 Social History::popup_menu::smoker::non-smoker
  48
  49 or
  50
  51 Social History::radio_group::smoker::non-smoker
  52
  53
  54 where the first item is the field name.  spaces within the name will convert to '_'
  55 for the sql database field name.  If you use a SQL reserved word, the form generation
  56 will fail and this program will notify you of the word(s) you used.
  57
  58 The '::' is the standard delimiter that I use between items.  The second item on the line
  59 is the form widget type.  You can choose from:
  60
  61 textfield
  62 textarea
  63 checkbox
  64 checkbox_group
  65 radio_group
  66 popup_menu
  67 scrolling_list
  68 scrolling_list_multiples
  69
  70 Putting a '+' at the beginning of the field name will let the form know that you want to
  71 report negatives.  This means the following:
  72
  73 +cardiac_review::checkbox_group::chest pain::shortness of breath::palpitations
  74
  75 creates a group of checkboxes where if the user chooses the first two boxes, the database will
  76 have the following line entered:
  77
  78 chest pain, shortness of breath.  Negative for palpitations.
  79
  80 The remaining items after the fieldname and the widget type  are the names for
  81 checkboxes or radio buttons or default text
  82 for a textfield or text area.  You can also start a line with a '#' as the first character and this
  83 will be an ignored comment line.  If you put html tags on their own lines, they will be integrated
  84 into the form.  It will be most helpful to look at 'sample.txt' to see how this works.
  85
  86 This is 1.1 and is tested to the extent of installing the form and entering data within an encounter.
  87 Please send feedback to mail@doc99.com.  I will definitely
  88 be fixing and improving it.
  89
  90 Mark Leeds
  91
  92
  93 START
  94
  95 #info.txt
  96 my $info_txt=<<'START';
  97 FORM_NAME
  98 START
  99
 100 my $do_not_save=<<'START';
 101 <?
 102 echo "<a href='".$GLOBALS['webroot'] . "/interface/patient_file/encounter/patient_encounter.php'>[do not save]</a>";
 103 ?>
 104 START
 105
 106 #new.php
 107 my $new_php =<<'START';
 108 <?php
 109 include_once("../../globals.php");
 110 include_once("$srcdir/api.inc");
 111 formHeader("Form: FORM_NAME");
 112 ?>
 113 <html><head>
 114 <link rel=stylesheet href="<?echo $css_header;?>" type="text/css">
 115 </head>
 116 <body <?echo $top_bg_line;?> topmargin=0 rightmargin=0 leftmargin=2 bottommargin=0 marginwidth=2 marginheight=0>
 117 <form method=post action="<?echo $rootdir;?>/forms/FORM_NAME/save.php?mode=new" name="FORM_NAME">
 118 <hr>
 119 <h1> FORM_NAME </h1>
 120 <hr>
 121
 122 DATABASEFIELDS
 123
 124 </form>
 125 <?php
 126 formFooter();
 127 ?>
 128 START
 129
 130 #print.php
 131 my $print_php=<<'START';
 132 <?php
 133 include_once("../../globals.php");
 134 include_once("$srcdir/api.inc");
 135 formHeader("Form: FORM_NAME");
 136 ?>
 137 <html><head>
 138 <link rel=stylesheet href="<?echo $css_header;?>" type="text/css">
 139 </head>
 140 <body <?echo $top_bg_line;?> topmargin=0 rightmargin=0 leftmargin=2 bottommargin=0 marginwidth=2 marginheight=0>
 141 <form method=post action="<?echo $rootdir;?>/forms/FORM_NAME/save.php?mode=new" name="my_form">
 142 <h1> FORM_NAME </h1>
 143 <hr>
 144 DATABASEFIELDS
 145 </form>
 146 <?php
 147 formFooter();
 148 ?>
 149 START
 150
 151 #report.php
 152 my $report_php=<<'START';
 153 <?php
 154 //------------report.php
 155 include_once("../../globals.php");
 156 include_once($GLOBALS["srcdir"]."/api.inc");
 157 function FORM_NAME_report( $pid, $encounter, $cols, $id) {
 158 $count = 0;
 159 $data = formFetch("form_FORM_NAME", $id);
 160 if ($data) {
 161 print "<table><tr>";
 162 foreach($data as $key => $value) {
 163 if ($key == "id" || $key == "pid" || $key == "user" || $key == "groupname" || $key == "authorized" || $key == "activity" || $key == "date" || $value == "" || $value == "0000-00-00 00:00:00") {
 164         continue;
 165 }
 166 if ($value == "on") {
 167 $value = "yes";
 168 }
 169 $key=ucwords(str_replace("_"," ",$key));
 170 $output = stripslashes($value);
 171 print "<td><span class=bold>$key: </span><span class=text>$output</span></td>";
 172 $count++;
 173 if ($count == $cols) {
 174 $count = 0;
 175 print "</tr><tr>\n";
 176 }
 177 }
 178 }
 179 print "</tr></table>";
 180 }
 181 ?>
 182 START
 183
 184 #save.php
 185 my $save_php=<<'START';
 186 <?php
 187 //------------This file inserts your field data into the MySQL database
 188 include_once("../../globals.php");
 189 include_once("$srcdir/api.inc");
 190 include_once("$srcdir/forms.inc");
 191
 192 //process form variables here
 193 //create an array of all of the existing field names
 194 $field_names = array(FIELDNAMES);
 195 $negatives = array(NEGATIVES);
 196 //process each field according to it's type
 197 foreach($field_names as $key=>$val)
 198 {
 199         if ($val == "checkbox")
 200         {
 201                 if ($_POST[$key]) {$field_names[$key] = "positve";}
 202                 else {$field_names[$key] = "negative";}
 203         }
 204         elseif (($val == "checkbox_group")||($val == "scrolling_list_multiples"))
 205         {
 206                 $neg = '';
 207                 if (array_key_exists($key,$negatives)) #a field requests reporting of negatives
 208                 {
 209                         foreach($_POST[$key] as $pos) #check positives against list
 210                         {
 211                                 if (array_key_exists($pos, $negatives[$key]))
 212                                 {       #remove positives from list, leaving negatives
 213                                         unset($negatives[$key][$pos]);
 214                                 }
 215                         }
 216                         $neg = ".   Negative for ".implode(', ',$negatives[$key]);
 217                 }
 218                 $field_names[$key] = implode(', ',$_POST[$key]).$neg;
 219         }
 220         else
 221         {
 222                 $field_names[$key] = $_POST[$key];
 223         }
 224 }
 225
 226 //end special processing
 227
 228 foreach ($field_names as $k => $var) {
 229 $field_names[$k] = mysql_real_escape_string($var);
 230 echo "$var\n";
 231 }
 232 if ($encounter == "")
 233 $encounter = date("Ymd");
 234 if ($_GET["mode"] == "new"){
 235 $newid = formSubmit("form_FORM_NAME", $field_names, $_GET["id"], $userauthorized);
 236 addForm($encounter, "FORM_NAME", $newid, "FORM_NAME", $pid, $userauthorized);
 237 }elseif ($_GET["mode"] == "update") {
 238
 239
 240 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");
 241 }
 242 $_SESSION["encounter"] = $encounter;
 243 formHeader("Redirecting....");
 244 formJump();
 245 formFooter();
 246 ?>
 247 START
 248
 249 #table.sql
 250 my $table_sql=<<'START';
 251 CREATE TABLE IF NOT EXISTS `form_FORM_NAME` (
 252 id bigint(20) NOT NULL auto_increment,
 253 date datetime default NULL,
 254 pid bigint(20) default NULL,
 255 user varchar(255) default NULL,
 256 groupname varchar(255) default NULL,
 257 authorized tinyint(4) default NULL,
 258 activity tinyint(4) default NULL,
 259 DATABASEFIELDS
 260 PRIMARY KEY (id)
 261 ) TYPE=MyISAM;
 262 START
 263
 264 #view.php
 265 my $view_php =<<'START';
 266 <!-- view.php -->
 267 <?php
 268 include_once("../../globals.php");
 269 include_once("$srcdir/api.inc");
 270 formHeader("Form: FORM_NAME");
 271 ?>
 272 <html><head>
 273 <link rel=stylesheet href="<?echo $css_header;?>" type="text/css">
 274 </head>
 275 <body <?echo $top_bg_line;?> topmargin=0 rightmargin=0 leftmargin=2 bottommargin=0 marginwidth=2 marginheight=0>
 276 <form method=post action="<?echo $rootdir?>/forms/FORM_NAME/save.php?mode=update&id=<?echo $_GET["id"];?>" name="my_form">
 277 <h1> FORM_NAME </h1>
 278 <hr>
 279 DATABASEFIELDS
 280
 281 </form>
 282 <?php
 283 formFooter();
 284 ?>
 285 START
 286
 287 #preview.html
 288 my $preview_html =<<'START';
 289 <html><head>
 290 </head>
 291 <body>
 292 <form>
 293 <hr>
 294 <h1> FORM_NAME </h1>
 295 <hr>
 296 DATABASEFIELDS
 297 </form>
 298 </body>
 299 </html>
 300 START
 301
 302 #sample.txt
 303 my $sample_txt =<<'START';
 304 a1_preop_physical
 305
 306 chief_complaints::textarea
 307
 308 <h3>past surgical history</h3>
 309 +surgical history::checkbox_group::cholecystectomy::tonsillectomy::apendectomy
 310 <h4>other</h4>
 311 surgical history other::textfield
 312
 313 <h3>past surgical history</h3>
 314 +medical history::scrolling_list_multiples::asthma::diabetes::hypertension
 315 <h4>other</h4>
 316 medical history other::textfield
 317
 318 <h2>Allergies</h2>
 319 +allergies::checkbox_group::penicillin::sulfa::iodine
 320 <h4>other</h4>
 321 allergies other::textfield
 322
 323 <h2>Social History</h2>
 324 <h3>smoking</h3>
 325 smoke history::radio_group::non-smoker::smoker
 326 <h3>alcohol</h3>
 327 etoh history::scrolling_list::none::occasional::daily::heavy use
 328 START
 329
 330 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');
 331 my %reserved;
 332 $reserved{uc $_}++ for @reserved;
 333
 334 #main program
 335
 336 if (@ARGV == 0)
 337 {
 338         to_file('sample.txt',$sample_txt) if not -f 'sample.txt';
 339         print $documentation."\n";
 340         exit 0;
 341 }
 342
 343 my $form_name = <>;
 344 chomp($form_name);
 345 my $check_reserved = uc $form_name;
 346 if ($reserved{uc $check_reserved})
 347 {
 348         print "You have chosen an SQL reserved word for your form name: $check_reserved.  Please try again.\n";
 349         exit 1;
 350 }
 351 $form_name =~ s/^\s+(\S)\s+$/$1/;
 352 $form_name =~ s/\s+/_/g;
 353 if (not -d $form_name)
 354 {
 355         mkdir "$form_name" or die "Could not create directory $form_name: $!";
 356 }
 357 my @field_data; #the very important array of field data
 358 chomp, push @field_data, [ split /::/ ] while <>;
 359 my %negatives; #key=field name: these are the fields that require reporting of pertinant
 360                 #negatives.  will only apply to checkbox_group and scrolling_list_multiples types
 361 my @reserved_used;
 362 #strip outer spaces from field names and field types and change inner spaces to underscores
 363 #and check field names for SQL reserved words now
 364 for (@field_data)
 365 {
 366         if ($_->[0] and $_->[1])
 367         {
 368                 $_->[0] =~ s/^\s+(\S)\s+$/$1/;
 369                 $_->[0] =~ s/\s+/_/g;
 370                 $check_reserved = $_->[0] =~ m/(\w+)/ ? uc $1 : q{};
 371                 push @reserved_used, $check_reserved if $reserved{$check_reserved};
 372                 $_->[1] =~ s/^\s+(\S)\s+$/$1/;
 373                 if ($_->[0] =~ /^\+/) #a leading '+' indicates to print negatives
 374                 {               # or not checked values in a checkbox_group or scrolling_list_multiples
 375                         $_->[0] =~ s/^\+(.*)/$1/;
 376                         $negatives{$_->[0]}++;
 377                 }
 378         }
 379 }
 380 if (@reserved_used)
 381 {
 382         print "You have chosen the following reserved words as field names.  Please try again.\n";
 383         print "$_\n" for @reserved_used;
 384         exit 1;
 385 }
 386
 387 my $text = make_form(@field_data);
 388 my $out;
 389
 390 #info.txt
 391 $out = replace($info_txt, 'FORM_NAME', $form_name);
 392 to_file("$form_name/info.txt",$out);
 393
 394 #new.php
 395 $out = replace($new_php, 'FORM_NAME', $form_name);
 396 $out = replace($out, 'DATABASEFIELDS', $text);
 397 to_file("$form_name/new.php",$out);
 398
 399 #print.php
 400 $out = replace($print_php, 'FORM_NAME', $form_name);
 401 $out = replace($out, 'DATABASEFIELDS', $text);
 402 to_file("$form_name/print.php",$out);
 403
 404 #report.php
 405 $out = replace($report_php, 'FORM_NAME', $form_name);
 406 $out = replace($out, 'DATABASEFIELDS', $text);
 407 to_file("$form_name/report.php",$out);
 408
 409 #save.php
 410 $out = replace($save_php, 'FORM_NAME', $form_name);
 411 $out = replace_save_php($out, @field_data);
 412 to_file("$form_name/save.php",$out);
 413
 414 #view.php
 415 $out = replace($view_php, 'FORM_NAME', $form_name);
 416 $out = replace($out, 'DATABASEFIELDS', $text);
 417 to_file("$form_name/view.php",$out);
 418
 419 #table.sql
 420 $out = replace($table_sql, 'FORM_NAME', $form_name);
 421 $out = replace_sql($out, @field_data);
 422 to_file("$form_name/table.sql",$out);
 423
 424 #preview.html
 425 $out = replace($preview_html, 'FORM_NAME', $form_name);
 426 $out = replace($out, 'DATABASEFIELDS', $text);
 427 to_file("$form_name/preview.html",$out);
 428
 429 # subs
 430
 431 sub replace
 432 {
 433         my $text = shift;
 434         my %words = @_;
 435         $text =~ s/$_/$words{$_}/g for keys %words;
 436         return $text;
 437 }
 438
 439
 440 sub replace_save_php #a special case
 441 {
 442         my $text = shift;
 443         my @fields = map {$_->[0]} grep{$_->[0] and $_->[1]} @_;
 444         for (@fields)
 445         {
 446                  $_ = "$_='\".\$field_names[\"$_\"].\"'";
 447         }
 448         my $fields = join ',',@fields;
 449         $text =~ s/FIELDS/$fields/;
 450         @fields = ();
 451         my @negatives;
 452         for (@_)
 453         {
 454                 if ($_->[0] and $_->[1])
 455                 {
 456                         push @fields, "'$_->[0]' => '$_->[1]'";
 457                         if ($negatives{$_->[0]})
 458                         {
 459                                 my @temp;
 460                                 my $count = 2;
 461                                 while ($count < scalar(@$_))
 462                                 {
 463                                         push @temp, "'$_->[$count]' => '$_->[$count]'";
 464                                         $count++;
 465                                 }
 466                                 push @negatives, "'$_->[0]' => array(".join(', ', @temp).")";
 467                         }
 468                 }
 469         }
 470         $fields = join ', ', @fields;
 471         $text =~ s/FIELDNAMES/$fields/;
 472         my $negatives = join ', ', @negatives;
 473         $text =~ s/NEGATIVES/$negatives/;
 474         return $text;
 475 }
 476
 477 sub replace_sql #a special case
 478 {
 479         my $text = shift;
 480         my @fields = map {$_->[0]} grep{$_->[0] and $_->[1]} @_;
 481         my $replace = '';
 482         $replace .= "$_ TEXT,\n" for @fields;
 483         $text =~ s/DATABASEFIELDS/$replace/;
 484         return $text;
 485 }
 486
 487 sub make_form
 488 {
 489         my @data = @_;
 490         my $return = submit(-name=>'submit form') . $do_not_save;
 491         $return .= "<table>";
 492         for (@data)
 493         {
 494                 next if not $_->[0];
 495                 next if $_->[0] =~ /^#/; #ignore perl type comments
 496                 if ($_->[0] =~ /^\w/ and $_->[1])
 497                 {
 498                         for (@$_)
 499                         {
 500                                 s/'/\'/g;
 501                                 s/"/\"/g;
 502                         }
 503                         my $field_name = shift @$_;
 504                         my $field_type = shift @$_;
 505                         my $label = $field_name;
 506                         $label =~ s/_/ /g;
 507                         if ($field_type =~ /^textfield$/)
 508                         {
 509                                 $return .= Tr(td($label),td(textfield(-name=>$field_name, -value=> join @$_)))."\n";
 510                         }
 511                         elsif ($field_type =~ /^textarea$/)
 512                         {
 513                                 $return .= Tr(td($label),td(textarea(-name=>$field_name, -rows=>4, -columns=>40, -value=> join @$_)))."\n";
 514                         }
 515                         elsif ($field_type =~ /^radio_group$/)
 516                         {
 517                                 $return .= Tr(td($label),td(radio_group(-name=>$field_name, -values=>$_)))."\n";;
 518                         }
 519                         elsif ($field_type =~ /^checkbox$/)
 520                         {
 521                                 $return .= Tr(td($label),td(checkbox(-name=>$field_name, -value=>'yes', -label=> join @$_)))."\n";
 522                         }
 523                         elsif ($field_type =~ /^checkbox_group$/)
 524                         {
 525                                 $return .= Tr(td($label),td(checkbox_group(-name=>$field_name.'[]', -values=>$_)))."\n";
 526                         }
 527                         elsif ($field_type =~ /^popup_menu/)
 528                         {
 529                                 $return .= Tr(td($label),td(popup_menu(-name=>$field_name, -values=>$_)))."\n";
 530                         }
 531                         elsif ($field_type =~ /^scrolling_list/)
 532                         {
 533                                 my $mult = 'false';
 534                                 my $mult2 = '';
 535                                 $mult = 'true' if $field_type =~ /multiples$/;
 536                                 $mult2 = '[]' if $field_type =~ /multiples$/;
 537                                 $return .= Tr(td($label),td(scrolling_list(-name=>$field_name.$mult2, -values=>$_, -size=>scalar(@$_), -multiple=>$mult)))."\n";
 538                         }
 539                 unshift @$_, $field_type;
 540                 unshift @$_, $field_name;
 541                 }
 542                 else #probably an html tag or something
 543                 {
 544                         $return .= "</table>";
 545                         $return .= $_->[0]."\n";
 546                         $return .= "<table>";
 547                 }
 548         }
 549         $return .= "</table>";
 550         $return .= submit(-name=>'submit form') . $do_not_save;
 551         return $return;
 552 }
 553
 554 sub to_file
 555 {
 556         my $filename = shift;
 557         my $string = shift;
 558         my $file;
 559         open $file, '>', $filename or die "cannot open $filename: $!";
 560         print $file $string;
 561         close $file or die "cannot close $filename: $!";
 562 }