11 my $documentation =<<'START';
13 *************************************
14 * Form Generating Script 1.1 *
15 *************************************
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:
21 Perl formscript.pl [filename]
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.
27 Basically you enter one database field item per line like this:
29 Social History::popup_menu::smoker::non-smoker
33 Social History::radio_group::smoker::non-smoker
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.
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:
50 scrolling_list_multiples
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:
55 +cardiac_review::checkbox_group::chest pain::shortness of breath::palpitations
57 creates a group of checkboxes where if the user chooses the first two boxes, the database will
58 have the following line entered:
60 chest pain, shortness of breath. Negative for palpitations.
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.
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.
78 my $info_txt=<<'START';
83 my $new_php =<<'START';
85 include_once("../../globals.php");
86 include_once("$srcdir/api.inc");
87 formHeader("Form: FORM_NAME");
90 <link rel=stylesheet href="<?echo $css_header;?>" type="text/css">
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">
105 my $print_php=<<'START';
107 include_once("../../globals.php");
108 include_once("$srcdir/api.inc");
109 formHeader("Form: FORM_NAME");
112 <link rel=stylesheet href="<?echo $css_header;?>" type="text/css">
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">
126 my $report_php=<<'START';
128 //------------report.php
129 include_once("../../globals.php");
130 include_once($GLOBALS["srcdir"]."/api.inc");
131 function FORM_NAME_report( $pid, $encounter, $cols, $id) {
133 $data = formFetch("form_FORM_NAME", $id);
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") {
140 if ($value == "on") {
143 $key=ucwords(str_replace("_"," ",$key));
144 print "<td><span class=bold>$key: </span><span class=text>$value</span></td>";
146 if ($count == $cols) {
152 print "</tr></table>";
158 my $save_php=<<'START';
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");
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)
172 if ($val == "checkbox")
174 if ($_POST[$key]) {$field_names[$key] = "positve";}
175 else {$field_names[$key] = "negative";}
177 elseif (($val == "checkbox_group")||($val == "scrolling_list_multiples"))
180 if (array_key_exists($key,$negatives)) #a field requests reporting of negatives
182 foreach($_POST[$key] as $pos) #check positives against list
184 if (array_key_exists($pos, $negatives[$key]))
185 { #remove positives from list, leaving negatives
186 unset($negatives[$key][$pos]);
189 $neg = ". Negative for ".implode(', ',$negatives[$key]);
191 $field_names[$key] = implode(', ',$_POST[$key]).$neg;
195 $field_names[$key] = $_POST[$key];
199 //end special processing
201 foreach ($field_names as $k => $var) {
202 $field_names[$k] = mysql_escape_string($var);
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") {
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");
215 $_SESSION["encounter"] = $encounter;
216 formHeader("Redirecting....");
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,
238 my $view_php =<<'START';
241 include_once("../../globals.php");
242 include_once("$srcdir/api.inc");
243 formHeader("Form: FORM_NAME");
246 <link rel=stylesheet href="<?echo $css_header;?>" type="text/css">
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">
261 my $preview_html =<<'START';
276 my $sample_txt =<<'START';
279 chief_complaints::textarea
281 <h3>past surgical history</h3>
282 +surgical history::checkbox_group::cholecystectomy::tonsillectomy::apendectomy
284 surgical history other::textfield
286 <h3>past surgical history</h3>
287 +medical history::scrolling_list_multiples::asthma::diabetes::hypertension
289 medical history other::textfield
292 +allergies::checkbox_group::penicillin::sulfa::iodine
294 allergies other::textfield
296 <h2>Social History</h2>
298 smoke history::radio_group::non-smoker::smoker
300 etoh history::scrolling_list::none::occasional::daily::heavy use
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');
305 $reserved{$_}++ for @reserved;
311 to_file
('sample.txt',$sample_txt) if not -f
'sample.txt';
312 print $documentation."\n";
318 if ($reserved{$form_name})
320 print "You have chosen an SQL reserved word for your form name: $form_name. Please try again.\n";
323 $form_name =~ s/^\s+(\S)\s+$/$1/;
324 $form_name =~ s/\s+/_/g;
325 if (not -d
$form_name)
327 mkdir "$form_name" or die "Could not create directory $form_name: $!";
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
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
338 if ($_->[0] and $_->[1])
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]}++;
353 print "You have chosen the following reserved words as field names. Please try again.\n";
354 print "$_\n" for @reserved_used;
358 my $text = make_form
(@field_data);
362 $out = replace
($info_txt, 'FORM_NAME', $form_name);
363 to_file
("$form_name/info.txt",$out);
366 $out = replace
($new_php, 'FORM_NAME', $form_name);
367 $out = replace
($out, 'DATABASEFIELDS', $text);
368 to_file
("$form_name/new.php",$out);
371 $out = replace
($print_php, 'FORM_NAME', $form_name);
372 $out = replace
($out, 'DATABASEFIELDS', $text);
373 to_file
("$form_name/print.php",$out);
376 $out = replace
($report_php, 'FORM_NAME', $form_name);
377 $out = replace
($out, 'DATABASEFIELDS', $text);
378 to_file
("$form_name/report.php",$out);
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);
386 $out = replace
($view_php, 'FORM_NAME', $form_name);
387 $out = replace
($out, 'DATABASEFIELDS', $text);
388 to_file
("$form_name/view.php",$out);
391 $out = replace
($table_sql, 'FORM_NAME', $form_name);
392 $out = replace_sql
($out, @field_data);
393 to_file
("$form_name/table.sql",$out);
396 $out = replace
($preview_html, 'FORM_NAME', $form_name);
397 $out = replace
($out, 'DATABASEFIELDS', $text);
398 to_file
("$form_name/preview.html",$out);
406 $text =~ s/$_/$words{$_}/g for keys %words;
411 sub replace_save_php
#a special case
414 my @fields = map {$_->[0]} grep{$_->[0] and $_->[1]} @_;
417 $_ = "$_='\".\$field_names[\"$_\"].\"'";
419 my $fields = join ',',@fields;
420 $text =~ s/FIELDS/$fields/;
425 if ($_->[0] and $_->[1])
427 push @fields, "'$_->[0]' => '$_->[1]'";
428 if ($negatives{$_->[0]})
432 while ($count < scalar(@
$_))
434 push @temp, "'$_->[$count]' => '$_->[$count]'";
437 push @negatives, "'$_->[0]' => array(".join(', ', @temp).")";
441 $fields = join ', ', @fields;
442 $text =~ s/FIELDNAMES/$fields/;
443 my $negatives = join ', ', @negatives;
444 $text =~ s/NEGATIVES/$negatives/;
448 sub replace_sql
#a special case
451 my @fields = map {$_->[0]} grep{$_->[0] and $_->[1]} @_;
453 $replace .= "$_ TEXT,\n" for @fields;
454 $text =~ s/DATABASEFIELDS/$replace/;
461 my $return = submit
(-name
=>'submit form');
462 $return .= "<table>";
466 next if $_->[0] =~ /^#/; #ignore perl type comments
467 if ($_->[0] =~ /^\w/ and $_->[1])
469 my $field_name = shift @
$_;
470 my $field_type = shift @
$_;
471 my $label = $field_name;
473 if ($field_type =~ /^textfield$/)
475 $return .= Tr
(td
($label),td
(textfield
(-name
=>$field_name, -value
=> join @
$_)))."\n";
477 elsif ($field_type =~ /^textarea$/)
479 $return .= Tr
(td
($label),td
(textarea
(-name
=>$field_name, -rows
=>4, -columns
=>40, -value
=> join @
$_)))."\n";
481 elsif ($field_type =~ /^radio_group$/)
483 $return .= Tr
(td
($label),td
(radio_group
(-name
=>$field_name, -values=>$_)))."\n";;
485 elsif ($field_type =~ /^checkbox$/)
487 $return .= Tr
(td
($label),td
(checkbox
(-name
=>$field_name, -value
=>'yes', -label
=> join @
$_)))."\n";
489 elsif ($field_type =~ /^checkbox_group$/)
491 $return .= Tr
(td
($label),td
(checkbox_group
(-name
=>$field_name.'[]', -values=>$_)))."\n";
493 elsif ($field_type =~ /^popup_menu/)
495 $return .= Tr
(td
($label),td
(popup_menu
(-name
=>$field_name, -values=>$_)))."\n";
497 elsif ($field_type =~ /^scrolling_list/)
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";
505 unshift @
$_, $field_type;
506 unshift @
$_, $field_name;
508 else #probably an html tag or something
510 $return .= "</table>";
511 $return .= $_->[0]."\n";
512 $return .= "<table>";
515 $return .= "<table>";
516 $return .= submit
(-name
=>'submit form');
522 my $filename = shift;
525 open $file, '>', $filename or die "cannot open $filename: $!";
527 close $file or die "cannot close $filename: $!";