contrib/forms/formmaker/formscript.pl

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use CGI qw(:standard);
   7
   8 #if -noxl command line option is used, xl function will not be put into form
   9 use Getopt::Long;
  10 my $noxl = '';
  11 my $bigtable = '';
  12 my @redirect; #this array is for data if redirect field defined to send form data to other form...
  13 my $redirect_string = '';
  14 GetOptions('noxl' => \$noxl, 'bigtable' => \$bigtable);
  15
  16 #file templates here
  17
  18 #documentation
  19 my $documentation =<<'START';
  20
  21 *************************************
  22 *      Form Generating Script 2.0   *
  23 *************************************
  24
  25 To run at the shell command line, type:
  26
  27 Perl formscript.pl [filename]
  28
  29 where filename is a text file with data relating to your form.  If you run
  30 without a filename argument, a sample data file will be created in the same
  31 directory named 'sample.txt' that you can use to see how to create your own.
  32
  33 The first line you enter in your textfile is the name of the form.
  34 In the example this is "physical_sample"
  35
  36 Basically you enter one database field item per line like this:
  37
  38 Social History::popup_menu::smoker::non-smoker
  39
  40 or
  41
  42 Social History::radio_group::smoker::non-smoker
  43
  44
  45 where the first item is the field name, the second item is the widget type, and Nth items are values.
  46 spaces within the name will convert to '_'
  47 for the sql database field name.  If you use a SQL reserved word, the form generation
  48 will fail and this program will notify you of the word(s) you used.
  49
  50 The '::' is the standard delimiter that I use between items.  The second item on the line
  51 is the form widget type.  You can choose from:
  52
  53 textfield
  54 textarea
  55 checkbox
  56 checkbox_group
  57 radio_group
  58 popup_menu
  59 scrolling_list
  60 scrolling_list_multiples
  61 date
  62
  63 Putting a '+' at the beginning of the field name will let the form know that you want to
  64 report negatives.  This means the following:
  65
  66 +cardiac_review::checkbox_group::chest pain::shortness of breath::palpitations
  67
  68 creates a group of checkboxes where if the user chooses the first two boxes, the database will
  69 have the following line entered:
  70
  71 chest pain, shortness of breath.  Negative for palpitations.
  72
  73 The remaining items after the fieldname and the widget type  are the names for
  74 checkboxes or radio buttons or default text
  75 for a textfield or text area.  You can also start a line with a '#' as the first character and this
  76 will be an ignored comment line.  If you put html tags on their own lines, they will be integrated
  77 into the form.  It will be most helpful to look at 'sample.txt' to see how this works.
  78
  79 By default now, the xl function which is for performing language translation is used.  To disable this feature in creating a form, use the commandline option -noxl as in:
  80
  81 ./formscript.pl --noxl sample.txt
  82
  83 The bigtable option.  This commandline option ignores anything in the template file that is not a field and creates the form layout in one tidy table.  This may look nicer.  You can rebuild the form with and without this option without breaking anything even after the form is installed and in use.
  84
  85 ./formscript.pl --bigtable sample.txt
  86
  87 Redirect option.  This option is set within the template file by defining a redirect field just like any other field.  The redirect keyword is followed by the redirect keyword again and then by the table name to submit data to.  That is followed by the database column name to save data to.  All form data will be combined into one string and submitted to this table.  Optionally, you may then list other columns and a string to submit for each as a constant.  Example:
  88
  89 redirect::redirect::CAMOS::content::category::exam::subcategory::by_dx::item::bronchitis
  90
  91 Please send feedback to drleeds@gmail.com.
  92
  93
  94 START
  95
  96 #info.txt
  97 my $info_txt=<<'START';
  98 FORM_NAME
  99 START
 100
 101 #date header
 102 #if there is one or more date fields, this will need to be inserted into the body of new.php
 103 #for the popup javascript calendar
 104 my $date_field_exists = 0;
 105 my $date_header =<<'START';
 106 <style type="text/css">@import url(../../../library/dynarch_calendar.css);</style>
 107 <script type="text/javascript" src="../../../library/dialog.js"></script>
 108 <script type="text/javascript" src="../../../library/textformat.js"></script>
 109 <script type="text/javascript" src="../../../library/dynarch_calendar.js"></script>
 110 <script type="text/javascript" src="../../../library/dynarch_calendar_en.js"></script>
 111 <script type="text/javascript" src="../../../library/dynarch_calendar_setup.js"></script>
 112 <script language='JavaScript'> var mypcc = '1'; </script>
 113 START
 114
 115 #new.php
 116 my $new_php =<<'START';
 117 <?php
 118 include_once("../../globals.php");
 119 include_once("$srcdir/api.inc");
 120 formHeader("Form: FORM_NAME");
 121 $returnurl = $GLOBALS['concurrent_layout'] ? 'encounter_top.php' : 'patient_encounter.php';
 122 ?>
 123 <html><head>
 124 <link rel=stylesheet href="<?echo $css_header;?>" type="text/css">
 125 </head>
 126 <body <?echo $top_bg_line;?> topmargin=0 rightmargin=0 leftmargin=2 bottommargin=0 marginwidth=2 marginheight=0>
 127 DATE_HEADER
 128 <a href='<?php echo $GLOBALS['webroot']?>/interface/patient_file/encounter/<?php echo $returnurl?>' onclick='top.restoreSession()'>[do not save]</a>
 129 <form method=post action="<?echo $rootdir;?>/forms/FORM_NAME/save.php?mode=new" name="FORM_NAME" onsubmit="return top.restoreSession()">
 130 <hr>
 131 <h1>FORM_NAME</h1>
 132 <hr>
 133 DATABASEFIELDS
 134 </form>
 135 <a href='<?php echo $GLOBALS['webroot']?>/interface/patient_file/encounter/<?php echo $returnurl?>' onclick='top.restoreSession()'>[do not save]</a>
 136 <?php
 137 formFooter();
 138 ?>
 139 START
 140
 141 #print.php
 142 my $print_php=<<'START';
 143 <?php
 144 include_once("../../globals.php");
 145 include_once("$srcdir/api.inc");
 146 formHeader("Form: FORM_NAME");
 147 ?>
 148 <html><head>
 149 <link rel=stylesheet href="<?echo $css_header;?>" type="text/css">
 150 </head>
 151 <body <?echo $top_bg_line;?> topmargin=0 rightmargin=0 leftmargin=2 bottommargin=0 marginwidth=2 marginheight=0>
 152 <form method=post action="<?echo $rootdir;?>/forms/FORM_NAME/save.php?mode=new" name="my_form" onsubmit="return top.restoreSession()">
 153 <h1> FORM_NAME </h1>
 154 <hr>
 155 DATABASEFIELDS
 156 </form>
 157 <?php
 158 formFooter();
 159 ?>
 160 START
 161
 162 #report.php
 163 #The variable $mykey and $myval are used by the xl_fix function for replacement purposes
 164 my $report_php=<<'START';
 165 <?php
 166 //------------report.php
 167 include_once("../../globals.php");
 168 include_once($GLOBALS["srcdir"]."/api.inc");
 169 function FORM_NAME_report( $pid, $encounter, $cols, $id) {
 170 $count = 0;
 171 $data = formFetch("form_FORM_NAME", $id);
 172 if ($data) {
 173 print "<hr><table><tr>";
 174 foreach($data as $key => $value) {
 175 if ($key == "id" || $key == "pid" || $key == "user" || $key == "groupname" || $key == "authorized" || $key == "activity" || $key == "date" || $value == "" || $value == "0000-00-00 00:00:00") {
 176         continue;
 177 }
 178 if ($value == "on") {
 179 $value = "yes";
 180 }
 181 $key=ucwords(str_replace("_"," ",$key));
 182 $mykey = $key.": ";
 183 $myval = stripslashes($value);
 184 print "<td><span class=bold>".$mykey."</span><span class=text>".$myval."</span></td>";
 185 $count++;
 186 if ($count == $cols) {
 187 $count = 0;
 188 print "</tr><tr>\n";
 189 }
 190 }
 191 }
 192 print "</tr></table><hr>";
 193 }
 194 ?>
 195 START
 196
 197 #save.php
 198 my $save_php=<<'START';
 199 <?php
 200 //------------This file inserts your field data into the MySQL database
 201 include_once("../../globals.php");
 202 include_once("$srcdir/api.inc");
 203 include_once("$srcdir/forms.inc");
 204
 205 //process form variables here
 206 //create an array of all of the existing field names
 207 $field_names = array(FIELDNAMES);
 208 $negatives = array(NEGATIVES);
 209 //process each field according to it's type
 210 foreach($field_names as $key=>$val)
 211 {
 212   $pos = '';
 213   $neg = '';
 214         if ($val == "checkbox")
 215         {
 216                 if ($_POST[$key]) {$field_names[$key] = "yes";}
 217                 else {$field_names[$key] = "negative";}
 218         }
 219         elseif (($val == "checkbox_group")||($val == "scrolling_list_multiples"))
 220         {
 221                 if (array_key_exists($key,$negatives)) #a field requests reporting of negatives
 222                 {
 223                   if ($_POST[$key])
 224                   {
 225                         foreach($_POST[$key] as $var) #check positives against list
 226                         {
 227                                 if (array_key_exists($var, $negatives[$key]))
 228                                 {       #remove positives from list, leaving negatives
 229                                         unset($negatives[$key][$var]);
 230                                 }
 231                         }
 232                   }
 233                         if (is_array($negatives[$key]) && count($negatives[$key])>0)
 234                         {
 235                                 $neg = "Negative for ".implode(', ',$negatives[$key]).'.';
 236                         }
 237                 }
 238                 if (is_array($_POST[$key]) && count($_POST[$key])>0)
 239                 {
 240                         $pos = implode(', ',$_POST[$key]);
 241                 }
 242                 if($pos) {$pos = 'Positive for '.$pos.'.  ';}
 243                 $field_names[$key] = $pos.$neg;
 244         }
 245         else
 246         {
 247                 $field_names[$key] = $_POST[$key];
 248         }
 249         if ($field_names[$key] != '')
 250         {
 251 //          $field_names[$key] .= '.';
 252           $field_names[$key] = preg_replace('/\s*,\s*([^,]+)\./',' and $1.',$field_names[$key]); // replace last comma with 'and' and ending period
 253         }
 254 }
 255
 256 //end special processing
 257 if(get_magic_quotes_gpc()) {
 258   foreach ($field_names as $k => $var) {
 259     $field_names[$k] = stripslashes($var);
 260   }
 261 }
 262 foreach ($field_names as $k => $var) {
 263   #if (strtolower($k) == strtolower($var)) {unset($field_names[$k]);}
 264   $field_names[$k] = mysql_real_escape_string($var);
 265 echo "$var\n";
 266 }
 267 if ($encounter == "")
 268 $encounter = date("Ymd");
 269 if ($_GET["mode"] == "new"){
 270 reset($field_names);
 271 NOREDIRECT
 272 $_SESSION["encounter"] = $encounter;
 273 formHeader("Redirecting....");
 274 formJump();
 275 formFooter();
 276 ?>
 277 START
 278
 279 #save_noredirect
 280 #if there is no redirect command, replace NOREDIRECT with this
 281 my $noredirect=<<'START';
 282 $newid = formSubmit("form_FORM_NAME", $field_names, $_GET["id"], $userauthorized);
 283 addForm($encounter, "FORM_NAME", $newid, "FORM_NAME", $pid, $userauthorized);
 284 }elseif ($_GET["mode"] == "update") {
 285 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");
 286 }
 287 START
 288
 289 #table.sql
 290 my $table_sql=<<'START';
 291 CREATE TABLE IF NOT EXISTS `form_FORM_NAME` (
 292 id bigint(20) NOT NULL auto_increment,
 293 date datetime default NULL,
 294 pid bigint(20) default NULL,
 295 user varchar(255) default NULL,
 296 groupname varchar(255) default NULL,
 297 authorized tinyint(4) default NULL,
 298 activity tinyint(4) default NULL,
 299 DATABASEFIELDS
 300 PRIMARY KEY (id)
 301 ) TYPE=MyISAM;
 302 START
 303
 304 #view.php
 305 my $view_php =<<'START';
 306 <!-- view.php -->
 307 <?php
 308 include_once("../../globals.php");
 309 include_once("$srcdir/api.inc");
 310 formHeader("Form: FORM_NAME");
 311 $obj = formFetch("form_FORM_NAME", $_GET["id"]);  //#Use the formFetch function from api.inc to get values for existing form.
 312
 313 function chkdata_Txt(&$obj, $var) {
 314         return htmlentities($obj{"$var"});
 315 }
 316 function chkdata_Date(&$obj, $var) {
 317         return htmlentities($obj{"$var"});
 318 }
 319 function chkdata_CB(&$obj, $nam, $var) {
 320         if (preg_match("/Negative.*$var/",$obj{$nam})) {return;} else {return "checked";}
 321 }
 322 function chkdata_Radio(&$obj, $nam, $var) {
 323         if (strpos($obj{$nam},$var) !== false) {return "checked";}
 324 }
 325  function chkdata_PopOrScroll(&$obj, $nam, $var) {
 326         if (preg_match("/Negative.*$var/",$obj{$nam})) {return;} else {return "selected";}
 327 }
 328
 329 ?>
 330 <html><head>
 331 <link rel=stylesheet href="<?echo $css_header;?>" type="text/css">
 332 </head>
 333 <body <?echo $top_bg_line;?> topmargin=0 rightmargin=0 leftmargin=2 bottommargin=0 marginwidth=2 marginheight=0>
 334 DATE_HEADER
 335 <form method=post action="<?echo $rootdir?>/forms/FORM_NAME/save.php?mode=update&id=<?echo $_GET["id"];?>" name="my_form" onsubmit="return top.restoreSession()">
 336 <h1> FORM_NAME </h1>
 337 <hr>
 338 DATABASEFIELDS
 339
 340 </form>
 341 <?php
 342 formFooter();
 343 ?>
 344 START
 345
 346 #preview.html
 347 my $preview_html =<<'START';
 348 <html><head>
 349 </head>
 350 <body>
 351 <form>
 352 <hr>
 353 <h1> FORM_NAME </h1>
 354 <hr>
 355 DATABASEFIELDS
 356 </form>
 357 </body>
 358 </html>
 359 START
 360
 361 #sample.txt
 362 my $sample_txt =<<'START';
 363 physical_sample
 364
 365 chief_complaints::textarea
 366
 367 <h3>past surgical history</h3>
 368 +surgical history::checkbox_group::cholecystectomy::tonsillectomy::apendectomy::hernia
 369 <h4>other</h4>
 370 surgical history other::textfield
 371
 372 <h3>past medical history</h3>
 373 +medical history::scrolling_list_multiples::asthma::diabetes::hypertension::GERD
 374 <h4>other</h4>
 375 medical history other::textfield
 376
 377 <h2>Allergies</h2>
 378 +allergies::checkbox_group::penicillin::sulfa::iodine
 379 <h4>other</h4>
 380 allergies other::textfield
 381
 382 <h2>Social History</h2>
 383 <h3>smoking</h3>
 384 smoke history::radio_group::non-smoker::smoker
 385 <h3>alcohol</h3>
 386 etoh history::scrolling_list::none::occasional::daily::heavy use
 387 <h3>last mammogram</h3>
 388 last mammogram::date
 389 START
 390
 391 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');
 392 my %reserved;
 393 $reserved{$_}++ for @reserved;     # Shortened syntax for assigning value of 1 to each associative element in array.
 394                                              # IE:  UNLOCK = 1, WRITE = 1, ETC... Associative array.
 395
 396
 397
 398
 399 #*********************************************************************************
 400 #******************************** MAIN PROGRAM ***********************************
 401 #*********************************************************************************
 402
 403 if (@ARGV == 0)
 404 {
 405         to_file('sample.txt',$sample_txt) if not -f 'sample.txt';
 406         print $documentation."\n";
 407         exit 0;
 408 }
 409 my $template_file_name = $ARGV[0];
 410 my $form_name = <>;
 411 chomp($form_name);
 412 my $compare = $form_name;
 413 $compare =~ tr/[a-z]/[A-Z]/;
 414 if ($reserved{$compare})
 415 {
 416         print "You have chosen an SQL reserved word for your form name: $form_name.  Please try again.\n";
 417         exit 1;
 418 }
 419 $form_name =~ s/^\s+(\S)\s+$/$1/;       #Remove spaces from beginning and end of form name and save $1 which is a backreference to subexpression ("\S" MEANS Any non-whitespace character)) to $form_name.
 420 $form_name =~ s/\s+/_/g;                #Substitute all blank spaces with _ globally --> g means globally.
 421 if (! -e $form_name)
 422 {
 423         mkdir "$form_name" or die "Could not create directory $form_name: $!";
 424 }
 425 my @field_data;                                                                                  #the very important array of field data
 426 chomp, push @field_data, [ split /::/ ] while <>;               #while <> continues through currently open file (parameter from command line invoking perl ie: "subjective.txt"), chomping return characters, splitting on :: or more (::::) and putting into field_data array.
 427 my %negatives;               #key=field name: these are the fields that require reporting of pertinant
 428                                      #negatives.  will only apply to checkbox_group and scrolling_list_multiples types
 429 my @reserved_used;
 430 #strip outer spaces from field names and field types and change inner spaces to underscores
 431 #and check field names for SQL reserved words now
 432 for (@field_data)
 433 {
 434         if ($_->[0] and $_->[1])        #$_->[0] is field name and $_->[1] is field type.  IE:  @field_data[4]->[0] and @field_data[4]->[1]
 435         {
 436                 $_->[0] =~ s/^\s+(\S)\s+$/$1/;        #\s means spaces, \S means non spaces. (\S) creates backreference pointed to by $1 at end. ***FIELD NAME***
 437                 $_->[0] = lc $_->[0];           #MAKE SURE FILENAMES ARE ALL LOWERCASE (to avoid problems later)
 438                 $_->[0] =~ s/\s+|-+/_/g;                 # So now @field_data[1]->[0] contains the field name without spaces at beginning or end and this replaces spaces with _  ie: "field type" becomes "field_type"
 439                 push @reserved_used, $_->[0] if $reserved{$_->[0]};
 440                 $_->[1] =~ s/^\s+(\S)\s+$/$1/;
 441                 if ($_->[0] =~ /^\+/) #a leading '+' indicates to print negatives
 442                 {               # or not checked values in a checkbox_group or scrolling_list_multiples
 443                         $_->[0] =~ s/^\+(.*)/$1/;
 444                         $negatives{$_->[0]}++;      #Shortened syntax for putting $field_name, 1 into "negatives" associative array.
 445                                                             #Same as %negatives = (%negatives, $_->[0], 1)
 446                 }
 447         }
 448 }
 449 if (@reserved_used)
 450 {
 451         print "You have chosen the following reserved words as field names.  Please try again.\n";
 452         print "$_\n" for @reserved_used;
 453         exit 1;
 454 }
 455
 456
 457
 458 #****************************************************************************
 459 #**Send field data to the Make_form subroutine and receive it back as $text**
 460 #****************************************************************************
 461
 462 my $make_form_results = make_form(@field_data);
 463 my $out;
 464
 465
 466
 467 #***************************************************************************
 468 #**************************REPLACEMENT SECTION******************************
 469 #***************************************************************************
 470 #***This section replaces the 'PLACE_HOLDERS' in the $whatever.php above.***
 471 #***$text holds the results from the "make_form" subroutine below.       ***
 472 #***************************************************************************
 473
 474
 475 #info.txt
 476 $out = replace($info_txt, 'FORM_NAME', $form_name); #Custom delcared sub 3 parameters
 477 to_file("$form_name/info.txt",$out);
 478
 479 #new.php
 480 $out = replace($new_php, 'FORM_NAME', $form_name);
 481 $out = replace($out, 'DATABASEFIELDS', $make_form_results);
 482 $out = xl_fix($out);
 483 if ($date_field_exists) {
 484   $out = replace($out,'DATE_HEADER',$date_header);
 485 }
 486 to_file("$form_name/new.php",$out);
 487
 488 #print.php
 489 $out = replace($print_php, 'FORM_NAME', $form_name);
 490 $out = replace($out, 'DATABASEFIELDS', $make_form_results);
 491 $out = xl_fix($out);
 492 to_file("$form_name/print.php",$out);
 493
 494 #report.php
 495 $out = replace($report_php, 'FORM_NAME', $form_name);   #Here's where we set $out = to it's corresponding input (whatever_php) and replace the place holder 'FORM_NAME' with the correct $form_name
 496 $out = replace($out, 'DATABASEFIELDS', $make_form_results);             #Then replace 'DATABASEFIELDS' in 'whatever_php' with $make_form_results, generated from make_form subroutine.
 497 $out = xl_fix2($out);
 498 to_file("$form_name/report.php",$out);
 499
 500 #save.php
 501 $out = replace($save_php, 'NOREDIRECT', $noredirect) if not $redirect_string;
 502 $out = replace($save_php, 'NOREDIRECT', $redirect_string) if $redirect_string;
 503 $out = replace($out, 'FORM_NAME', $form_name);
 504 $out = replace_save_php($out, @field_data);             #Or send it to a special case where extra things can be added to the output. ("replace_save_php" is down below under "sub-routines")
 505 to_file("$form_name/save.php",$out);
 506
 507 #view.php
 508 $out = replace($view_php, 'FORM_NAME', $form_name);
 509 $out = replace($out, 'DATABASEFIELDS', $make_form_results);
 510 #$out = replace($out, 'FIELDARRAY', "'".join("'=>1,'",map {shift @$_;shift @$_;shift @$_;join("'=>1,'",@$_)} grep{$_->[3]} @field_data)."'=>1");
 511 #$out = replace($out, 'FIELDARRAY', "'".join("','",map {shift @$_;shift @$_;shift @$_;join("','",@$_)} grep{$_->[3]} @field_data)."'");
 512 $out = replace_view_php($out);
 513 $out = xl_fix($out);
 514 if ($date_field_exists) {
 515   $out = replace($out,'DATE_HEADER',$date_header);
 516 }
 517 to_file("$form_name/view.php",$out);
 518
 519 #table.sql
 520 $out = replace($table_sql, 'FORM_NAME', $form_name);
 521 $out = replace_sql($out, @field_data);
 522 to_file("$form_name/table.sql",$out);
 523
 524 #preview.html
 525 $out = replace($preview_html, 'FORM_NAME', $form_name);
 526 $out = replace($out, 'DATABASEFIELDS', $make_form_results);
 527 to_file("$form_name/preview.html",$out);
 528
 529 #copy template file to form directory
 530
 531
 532
 533 #******************************************************************
 534 #************************* SUBROUTINES ***************************
 535 #******************************************************************
 536
 537 sub replace
 538 {
 539         my $text = shift;  #This shifts through the supplied arguments ($whatever_php, 'FORM_NAME', and $form_name)
 540                                 #This $text is a LOCAL variable.  Does not overwrite other $make_form_results
 541                                 #Shift starts with the first value.  If variable (as in $whatever_php) expands and goes through line by line
 542         my %words = @_;
 543         $text =~ s/$_/$words{$_}/g for keys %words;
 544         return $text;
 545 }
 546
 547
 548 sub replace_save_php #a special case
 549 {
 550         my $text = shift;
 551         my @fields = map {$_->[0]} grep{$_->[0] and $_->[1]} @_;  #Checks to see that Field_name and Field_type exist --Grep statement and map to @array.
 552         for (@fields)
 553         {
 554                  $_ = "$_='\".\$field_names[\"$_\"].\"'";
 555         }
 556         my $fields = join ',',@fields;
 557         $text =~ s/FIELDS/$fields/;
 558         @fields = ();
 559         my @negatives;
 560         for (@_)
 561         {
 562                 if ($_->[0] and $_->[1])
 563                 {
 564                         push @fields, "'$_->[0]' => '$_->[1]'";
 565                         if ($negatives{$_->[0]})
 566                         {
 567                                 my @temp;
 568                                 my $count = 3;
 569                                 while ($count < scalar(@$_))
 570                                 {
 571                                         push @temp, "'$_->[$count]' => '$_->[$count]'";
 572                                         $count++;
 573                                 }
 574                                 push @negatives, "'$_->[0]' => array(".join(',', @temp).")";
 575                         }
 576                 }
 577         }
 578         $fields = join ',', @fields;
 579         $text =~ s/FIELDNAMES/$fields/;
 580         my $negatives = join ',', @negatives;
 581         $text =~ s/NEGATIVES/$negatives/;
 582         return $text;
 583 }
 584
 585 sub replace_sql #a special case
 586 {
 587         my $text = shift;
 588         my $replace = '';
 589         for (grep{$_->[0] and $_->[1]} @_)
 590         {
 591           next if $_->[0] eq 'redirect';
 592           $replace .= $_->[0]." TEXT,\n" if $_->[1] !~ /^date$/;
 593           $replace .= $_->[0]." DATE,\n" if $_->[1] =~ /^date$/;
 594         }
 595         $text =~ s/DATABASEFIELDS/$replace/;
 596         return $text;
 597 }
 598
 599 sub replace_view_php           #a special case  (They're all special cases aren't they? ;^ )  )
 600 {
 601         my $text = shift;
 602         $text =~ s/(<\/label>)\s?(<label>)/$1\n$2/g;            #MAKE LAYOUT MORE READABLE. NEWLINE FOR EACH <LABEL> TAG
 603         my @text = split (/\n/,$text);                          #PUT EACH LINE OF TEXT INTO AN ARRAY SPLIT ON NEWLINE (\n)
 604         my @temp = ();
 605         my $selname = "";
 606         foreach (@text)
 607         {
 608                 if ($_ =~ /<select name="(\w*)/) #SELECT NAME FOR POPUP & SCROLLING MENUS.
 609                         {
 610                           $selname = $1;
 611                           goto go;
 612                         }
 613
 614           goto go if $_ =~ s/(<textarea\sname=")([\w\s]+)("[\w\s="]*>)/$1$2$3<?php \$result = chkdata_Txt(\$obj,"$2"); echo \$result;?>/;  #TEXTAREA
 615
 616           goto go if $_ =~ s/(<input\stype="text"\s)(name=")([\w\s]+)(")([^>]*)/$1$2$3$4 value="<?php \$result = chkdata_Txt(\$obj,"$3"); echo \$result;?>"/;               #TEXT
 617
 618           goto go if $_ =~ s/(<input\stype="checkbox"\sname=")([\w\s]+)(\[\])("\svalue=")([\w\s]+)(")([^>]*)/$1$2$3$4$5$6 <?php \$result = chkdata_CB(\$obj,"$2","$5"); echo \$result;?>/;   #CHECKBOX-GROUP
 619
 620           goto go if $_ =~ s/(<input\stype="checkbox"\sname=")([\w\s]+)("\svalue=")([\w\s]+)(")([^>]*)/$1$2$3$4$5 <?php \$result = chkdata_CB(\$obj,"$2","$4"); echo \$result;?>/; #CHECKBOX
 621
 622           goto go if $_ =~ s/(<input\stype="radio"\sname=")([\w\s]+)("\svalue=")([\w\s]+)(")([^>]*)/$1$2$3$4$5 <?php \$result = chkdata_Radio(\$obj,"$2","$4"); echo \$result;?>/; #RADIO-GROUP
 623
 624           goto go if $_ =~ s/(<option value=")([\w\s]+)(")/$1$2$3 <?php \$result = chkdata_PopOrScroll(\$obj,"$selname","$2"); echo \$result;?>/g; #SCROLLING-LISTS-BOTH & POPUP-MENU
 625           goto go if $_ =~ s/(.*?)name='(.*?)'(.*?)datekeyup(.*?)dateblur(.*?)\/>/$1name='$2'$3datekeyup$4dateblur$5 value="<?php \$result = chkdata_Date(\$obj,"$2"); echo \$result;?>">/; #DATE
 626
 627                 go:     push (@temp, $_, "\n");
 628
 629         }
 630
 631         $text = "@temp";
 632         return $text;
 633 }
 634
 635
 636 sub make_form #MAKE_FORM
 637 {
 638         my @data = @_;
 639         my $return = submit(-name=>'submit form');
 640         $return .= '<br>'."\n";
 641         $return .= "\n".'<table>'."\n\n" if $bigtable;
 642         for (@data)
 643         {
 644                 next if not $_->[0];            #Go to next iteration of loop if no "field name"
 645                 next if $_->[0] =~ /^#/;        #ignore perl type comments
 646                 if ($_->[0] =~ /^\w/ and $_->[1])       #Check that the "field name" contains valid characters and that there is a "field type" in array iteration.
 647                 {
 648                         my $field_name = shift @$_;     #Get current field_name for iteration of array.  Shift removes it from the array and moves to next.
 649                         my $field_type = shift @$_;
 650                         my $label = $field_name;
 651                         $label =~ s/_/ /g;
 652                         $label = ucfirst($label);
 653                         $return .= "\n".'<table>'."\n\n" if not $bigtable;
 654                         if ($field_type =~ /^textfield$/)
 655                         {
 656                                 $return .= Tr(td($label),td(textfield(-name=>$field_name, -value=> join @$_)))."\n";
 657                         }
 658                         elsif ($field_type =~ /^textarea$/)
 659                         {
 660                                 $return .= Tr(td($label),td(textarea(-name=>$field_name, -rows=>4, -columns=>40, -value=> join @$_)))."\n";
 661                         }
 662                         elsif ($field_type =~ /^radio_group$/)
 663                         {
 664                                 $return .= Tr(td($label),td(radio_group(-name=>$field_name, -values=>$_, -default=>'-')))."\n";;
 665                         }
 666                         elsif ($field_type =~ /^checkbox$/)
 667                         {
 668                                 $return .= Tr(td($label),td(checkbox(-name=>$field_name, -value=>'yes', -label=> join @$_)))."\n";
 669                         }
 670                         elsif ($field_type =~ /^checkbox_group$/)
 671                         {
 672                                 $return .= Tr(td($label),td(checkbox_group(-name=>$field_name.'[]', -values=>$_)))."\n";
 673                         }
 674                         elsif ($field_type =~ /^popup_menu$/)
 675                         {
 676                                 $return .= Tr(td($label),td(popup_menu(-name=>$field_name, -values=>$_)))."\n";
 677                         }
 678                         elsif ($field_type =~ /^scrolling_list$/)
 679                         {
 680                                 $return .= Tr(td($label),td(scrolling_list(-name=>$field_name, -values=>$_, -size=>scalar(@$_))))."\n";
 681                         }
 682                         elsif ($field_type =~ /^scrolling_list_multiples/)
 683                         {
 684                                 $return .= Tr(td($label),td(scrolling_list(-name=>$field_name.'[]', -values=>$_, -size=>scalar(@$_), -multiple=>'true')))."\n";
 685                         }
 686                         elsif ($field_type =~ /^header/)
 687                         {
 688                                 $return .= Tr(td($label),td(hidden(-name=>$field_name, -value=>$field_name)))."\n";
 689                         }
 690                         elsif ($field_type =~ /^date$/)
 691                         {
 692 $date_field_exists = 1;
 693 $return .= <<"START";
 694 <tr><td>
 695 <span class='text'><?php xl('$label (yyyy-mm-dd): ','e') ?></span>
 696 </td><td>
 697 <input type='text' size='10' name='$field_name' id='$field_name' onkeyup='datekeyup(this,mypcc)' onblur='dateblur(this,mypcc)' title='yyyy-mm-dd last date of this event' />
 698 <img src='../../../interface/pic/show_calendar.gif' align='absbottom' width='24' height='22'
 699 id='img_$field_name' border='0' alt='[?]' style='cursor:pointer'
 700 title='Click here to choose a date'>
 701 <script>
 702 Calendar.setup({inputField:'$field_name', ifFormat:'%Y-%m-%d', button:'img_$field_name'});
 703 </script>
 704 </td></tr>
 705 START
 706                         }
 707                         elsif ($field_type =~ /^redirect/)
 708                         {
 709                                 #you could argue that this does not belong here and maybe more appropriately on the command line.
 710                                 #I just wanted to make it so redirect could be part of the template file and leverage existing functionality.
 711                                 @redirect = (@$_);
 712                                 my $formname = shift(@redirect);
 713                                 my $mainfield = shift(@redirect);
 714                                 my $field_constants;
 715                                 if (@redirect) {
 716                                         my %temp = @redirect;
 717                                         foreach(keys %temp) {
 718                                                 $field_constants .= "'$_' => '".$temp{$_}."', ";
 719                                         }
 720                                         $field_constants =~ s/, $/\)/;
 721                                         $field_constants = "array('$mainfield' => \$data,".$field_constants;
 722                                 } else {
 723                                         $field_constants = "array('$mainfield' => \$data)";
 724                                 }
 725 #                               my $t1 = "<tr><td><b>";
 726 #                               my $t2 = "</b></td></tr>";
 727 #                               my $t3 = "<tr><td>";
 728 #                               my $t4 = "</td>><td>";
 729 #                               my $t5 = "</tr></td>";
 730                                 my ($t1,$t2,$t3,$t4,$t5) = ('','','','','');
 731                                 $redirect_string = "\n}\n" .
 732 #                                       "\$data = \"<table>\\n\";\n" .
 733                                         "foreach (\$field_names as \$k => \$v) {\n" .
 734                                         "  if (\$k == \$v && \$v != '') {\/\/header\n" .
 735                                         "    \$data .= \"$t1\\n\\n\".\$k.\"$t2\\n\\n\";\n" .
 736                                         "  }\n" .
 737                                         "  elseif (\$v != '') {\n" .
 738                                         "    \$data .= \"$t3\".\$k.\": $t4\".\$v.\"$t5\\n\";\n" .
 739                                         "  }\n" .
 740                                         "}\n" .
 741 #                                       "\$data .= \"</table>\\n\";\n" .
 742                                         "\$newid = formSubmit(\"form_$formname\", $field_constants, \$_GET[\"id\"], \$userauthorized);\n" .
 743                                         "addForm(\$encounter, \"$formname\", \$newid, \"$formname\", \$pid, \$userauthorized);"
 744                         }
 745                         unshift @$_, $label;
 746                         unshift @$_, $field_type;
 747                         unshift @$_, $field_name;
 748                         $return .= "\n".'</table>'."\n" if not $bigtable;
 749                 }
 750                 elsif (!$bigtable) #probably an html tag or something -- Get to this point if no Field_name and Field_type found in array.
 751                 {
 752
 753                           if ($_->[0] !~ /<br>\s*$|<\/td>\s*$|<\/tr>\s*$|<\/p>\s*$/) {
 754                             $return .= '<br>'."\n";
 755                           }
 756
 757                           $return .= $_->[0]."\n";
 758
 759
 760                 }
 761         }
 762         $return .= "<table>" if not $bigtable;
 763         $return .= "</table>";
 764         $return .= submit(-name=>'submit form');
 765         return $return;
 766 }
 767
 768 #***********************************************************************************************************
 769 #**Receive 'full file path' and '$out' (finished output) from REPLACEMENT SECTION above and write to file.**
 770 #***********************************************************************************************************
 771
 772 sub to_file
 773 {
 774         my $filename = shift;
 775         my $string = shift;
 776         my $file;
 777         open $file, '>', $filename or die "cannot open $filename: $!";
 778         print $file $string;
 779         close $file or die "cannot close $filename: $!";
 780 }
 781 sub xl_fix #make compliant with translation feature
 782 {
 783         my $string = shift;
 784         return $string if $noxl;
 785         $string =~ s/>([^\s][^<>]+?)<\//> <\? xl("$1",'e') \?> <\//gs;
 786         return $string;
 787 }
 788 sub xl_fix2 #make compliant with translation feature for report.php
 789 {
 790         my $string = shift;
 791         return $string if $noxl;
 792         $string =~ s/\.(\$\w+)\./\.xl("$1")\./gs;
 793         return $string;
 794 }