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