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