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 <style type="text/css">@import url(../../../library/dynarch_calendar.css);</style>
 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"></script>
 109 <script type="text/javascript" src="../../../library/dynarch_calendar.js"></script>
 110 <?php include_once("{$GLOBALS['srcdir']}/dynarch_calendar_en.inc.php"); ?>
 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 = 'encounter_top.php';
 122 ?>
 123 <html><head>
 124 <link rel=stylesheet href="<?php echo $css_header;?>" type="text/css">
 125 </head>
 126 <body <?php 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="<?php 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="<?php echo $css_header;?>" type="text/css">
 150 </head>
 151 <body <?php echo $top_bg_line;?> topmargin=0 rightmargin=0 leftmargin=2 bottommargin=0 marginwidth=2 marginheight=0>
 152 <form method=post action="<?php 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 = $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 foreach ($field_names as $k => $var) {
 258   #if (strtolower($k) == strtolower($var)) {unset($field_names[$k]);}
 259   $field_names[$k] = formDataCore($var);
 260 echo "$var\n";
 261 }
 262 if ($encounter == "")
 263 $encounter = date("Ymd");
 264 if ($_GET["mode"] == "new"){
 265 reset($field_names);
 266 NOREDIRECT
 267 $_SESSION["encounter"] = $encounter;
 268 formHeader("Redirecting....");
 269 formJump();
 270 formFooter();
 271 ?>
 272 START
 273
 274 #save_noredirect
 275 #if there is no redirect command, replace NOREDIRECT with this
 276 my $noredirect=<<'START';
 277 $newid = formSubmit("form_FORM_NAME", $field_names, $_GET["id"], $userauthorized);
 278 addForm($encounter, "FORM_NAME", $newid, "FORM_NAME", $pid, $userauthorized);
 279 }elseif ($_GET["mode"] == "update") {
 280 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");
 281 }
 282 START
 283
 284 #table.sql
 285 my $table_sql=<<'START';
 286 CREATE TABLE IF NOT EXISTS `form_FORM_NAME` (
 287 id bigint(20) NOT NULL auto_increment,
 288 date datetime default NULL,
 289 pid bigint(20) default NULL,
 290 user varchar(255) default NULL,
 291 groupname varchar(255) default NULL,
 292 authorized tinyint(4) default NULL,
 293 activity tinyint(4) default NULL,
 294 DATABASEFIELDS
 295 PRIMARY KEY (id)
 296 ) ENGINE=InnoDB;
 297 START
 298
 299 #view.php
 300 my $view_php =<<'START';
 301 <!-- view.php -->
 302 <?php
 303 include_once("../../globals.php");
 304 include_once("$srcdir/api.inc");
 305 formHeader("Form: FORM_NAME");
 306 $obj = formFetch("form_FORM_NAME", $_GET["id"]);  //#Use the formFetch function from api.inc to get values for existing form.
 307
 308 function chkdata_Txt(&$obj, $var) {
 309         return htmlspecialchars($obj{"$var"},ENT_QUOTES);
 310 }
 311 function chkdata_Date(&$obj, $var) {
 312         return htmlspecialchars($obj{"$var"},ENT_QUOTES);
 313 }
 314 function chkdata_CB(&$obj, $nam, $var) {
 315         if (preg_match("/Negative.*$var/",$obj{$nam})) {return;} else {return "checked";}
 316 }
 317 function chkdata_Radio(&$obj, $nam, $var) {
 318         if (strpos($obj{$nam},$var) !== false) {return "checked";}
 319 }
 320  function chkdata_PopOrScroll(&$obj, $nam, $var) {
 321         if (preg_match("/Negative.*$var/",$obj{$nam})) {return;} else {return "selected";}
 322 }
 323
 324 ?>
 325 <html><head>
 326 <link rel=stylesheet href="<?php echo $css_header;?>" type="text/css">
 327 </head>
 328 <body <?php echo $top_bg_line;?> topmargin=0 rightmargin=0 leftmargin=2 bottommargin=0 marginwidth=2 marginheight=0>
 329 DATE_HEADER
 330 <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()">
 331 <h1> FORM_NAME </h1>
 332 <hr>
 333 DATABASEFIELDS
 334
 335 </form>
 336 <?php
 337 formFooter();
 338 ?>
 339 START
 340
 341 #preview.html
 342 my $preview_html =<<'START';
 343 <html><head>
 344 </head>
 345 <body>
 346 <form>
 347 <hr>
 348 <h1> FORM_NAME </h1>
 349 <hr>
 350 DATABASEFIELDS
 351 </form>
 352 </body>
 353 </html>
 354 START
 355
 356 #sample.txt
 357 my $sample_txt =<<'START';
 358 physical_sample
 359
 360 chief_complaints::textarea
 361
 362 <h3>past surgical history</h3>
 363 +surgical history::checkbox_group::cholecystectomy::tonsillectomy::apendectomy::hernia
 364 <h4>other</h4>
 365 surgical history other::textfield
 366
 367 <h3>past medical history</h3>
 368 +medical history::scrolling_list_multiples::asthma::diabetes::hypertension::GERD
 369 <h4>other</h4>
 370 medical history other::textfield
 371
 372 <h2>Allergies</h2>
 373 +allergies::checkbox_group::penicillin::sulfa::iodine
 374 <h4>other</h4>
 375 allergies other::textfield
 376
 377 <h2>Social History</h2>
 378 <h3>smoking</h3>
 379 smoke history::radio_group::non-smoker::smoker
 380 <h3>alcohol</h3>
 381 etoh history::scrolling_list::none::occasional::daily::heavy use
 382 <h3>last mammogram</h3>
 383 last mammogram::date
 384 START
 385
 386 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');
 387 my %reserved;
 388 $reserved{$_}++ for @reserved;     # Shortened syntax for assigning value of 1 to each associative element in array.
 389                                              # IE:  UNLOCK = 1, WRITE = 1, ETC... Associative array.
 390
 391
 392
 393
 394 #*********************************************************************************
 395 #******************************** MAIN PROGRAM ***********************************
 396 #*********************************************************************************
 397
 398 if (@ARGV == 0)
 399 {
 400         to_file('sample.txt',$sample_txt) if not -f 'sample.txt';
 401         print $documentation."\n";
 402         exit 0;
 403 }
 404 my $template_file_name = $ARGV[0];
 405 my $form_name = <>;
 406 chomp($form_name);
 407 my $compare = $form_name;
 408 $compare =~ tr/[a-z]/[A-Z]/;
 409 if ($reserved{$compare})
 410 {
 411         print "You have chosen an SQL reserved word for your form name: $form_name.  Please try again.\n";
 412         exit 1;
 413 }
 414 $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.
 415 $form_name =~ s/\s+/_/g;                #Substitute all blank spaces with _ globally --> g means globally.
 416 if (! -e $form_name)
 417 {
 418         mkdir "$form_name" or die "Could not create directory $form_name: $!";
 419 }
 420 my @field_data;                                                                                  #the very important array of field data
 421 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.
 422 my %negatives;               #key=field name: these are the fields that require reporting of pertinant
 423                                      #negatives.  will only apply to checkbox_group and scrolling_list_multiples types
 424 my @reserved_used;
 425 #strip outer spaces from field names and field types and change inner spaces to underscores
 426 #and check field names for SQL reserved words now
 427 for (@field_data)
 428 {
 429         if ($_->[0] and $_->[1])        #$_->[0] is field name and $_->[1] is field type.  IE:  @field_data[4]->[0] and @field_data[4]->[1]
 430         {
 431                 $_->[0] =~ s/^\s+(\S)\s+$/$1/;        #\s means spaces, \S means non spaces. (\S) creates backreference pointed to by $1 at end. ***FIELD NAME***
 432                 $_->[0] = lc $_->[0];           #MAKE SURE FILENAMES ARE ALL LOWERCASE (to avoid problems later)
 433                 $_->[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"
 434                 push @reserved_used, $_->[0] if $reserved{$_->[0]};
 435                 $_->[1] =~ s/^\s+(\S)\s+$/$1/;
 436                 if ($_->[0] =~ /^\+/) #a leading '+' indicates to print negatives
 437                 {               # or not checked values in a checkbox_group or scrolling_list_multiples
 438                         $_->[0] =~ s/^\+(.*)/$1/;
 439                         $negatives{$_->[0]}++;      #Shortened syntax for putting $field_name, 1 into "negatives" associative array.
 440                                                             #Same as %negatives = (%negatives, $_->[0], 1)
 441                 }
 442         }
 443 }
 444 if (@reserved_used)
 445 {
 446         print "You have chosen the following reserved words as field names.  Please try again.\n";
 447         print "$_\n" for @reserved_used;
 448         exit 1;
 449 }
 450
 451
 452
 453 #****************************************************************************
 454 #**Send field data to the Make_form subroutine and receive it back as $text**
 455 #****************************************************************************
 456
 457 my $make_form_results = make_form(@field_data);
 458 my $out;
 459
 460
 461
 462 #***************************************************************************
 463 #**************************REPLACEMENT SECTION******************************
 464 #***************************************************************************
 465 #***This section replaces the 'PLACE_HOLDERS' in the $whatever.php above.***
 466 #***$text holds the results from the "make_form" subroutine below.       ***
 467 #***************************************************************************
 468
 469
 470 #info.txt
 471 $out = replace($info_txt, 'FORM_NAME', $form_name); #Custom delcared sub 3 parameters
 472 to_file("$form_name/info.txt",$out);
 473
 474 #new.php
 475 $out = replace($new_php, 'FORM_NAME', $form_name);
 476 $out = replace($out, 'DATABASEFIELDS', $make_form_results);
 477 $out = xl_fix($out);
 478 if ($date_field_exists) {
 479   $out = replace($out,'DATE_HEADER',$date_header);
 480 }
 481 to_file("$form_name/new.php",$out);
 482
 483 #print.php
 484 $out = replace($print_php, 'FORM_NAME', $form_name);
 485 $out = replace($out, 'DATABASEFIELDS', $make_form_results);
 486 $out = xl_fix($out);
 487 to_file("$form_name/print.php",$out);
 488
 489 #report.php
 490 $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
 491 $out = replace($out, 'DATABASEFIELDS', $make_form_results);             #Then replace 'DATABASEFIELDS' in 'whatever_php' with $make_form_results, generated from make_form subroutine.
 492 $out = xl_fix2($out);
 493 to_file("$form_name/report.php",$out);
 494
 495 #save.php
 496 $out = replace($save_php, 'NOREDIRECT', $noredirect) if not $redirect_string;
 497 $out = replace($save_php, 'NOREDIRECT', $redirect_string) if $redirect_string;
 498 $out = replace($out, 'FORM_NAME', $form_name);
 499 $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")
 500 to_file("$form_name/save.php",$out);
 501
 502 #view.php
 503 $out = replace($view_php, 'FORM_NAME', $form_name);
 504 $out = replace($out, 'DATABASEFIELDS', $make_form_results);
 505 #$out = replace($out, 'FIELDARRAY', "'".join("'=>1,'",map {shift @$_;shift @$_;shift @$_;join("'=>1,'",@$_)} grep{$_->[3]} @field_data)."'=>1");
 506 #$out = replace($out, 'FIELDARRAY', "'".join("','",map {shift @$_;shift @$_;shift @$_;join("','",@$_)} grep{$_->[3]} @field_data)."'");
 507 $out = replace_view_php($out);
 508 $out = xl_fix($out);
 509 if ($date_field_exists) {
 510   $out = replace($out,'DATE_HEADER',$date_header);
 511 }
 512 to_file("$form_name/view.php",$out);
 513
 514 #table.sql
 515 $out = replace($table_sql, 'FORM_NAME', $form_name);
 516 $out = replace_sql($out, @field_data);
 517 to_file("$form_name/table.sql",$out);
 518
 519 #preview.html
 520 $out = replace($preview_html, 'FORM_NAME', $form_name);
 521 $out = replace($out, 'DATABASEFIELDS', $make_form_results);
 522 to_file("$form_name/preview.html",$out);
 523
 524 #copy template file to form directory
 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/(>{1,2})([^\s][^<>]+?)<\//$1 <\?php xl("$2",'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 }