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"></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 = $GLOBALS['concurrent_layout'] ? 'encounter_top.php' : 'patient_encounter.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 require_once("$srcdir/formdata.inc.php");
 205
 206 //process form variables here
 207 //create an array of all of the existing field names
 208 $field_names = array(FIELDNAMES);
 209 $negatives = array(NEGATIVES);
 210 //process each field according to it's type
 211 foreach($field_names as $key=>$val)
 212 {
 213   $pos = '';
 214   $neg = '';
 215         if ($val == "checkbox")
 216         {
 217                 if ($_POST[$key]) {$field_names[$key] = "yes";}
 218                 else {$field_names[$key] = "negative";}
 219         }
 220         elseif (($val == "checkbox_group")||($val == "scrolling_list_multiples"))
 221         {
 222                 if (array_key_exists($key,$negatives)) #a field requests reporting of negatives
 223                 {
 224                   if ($_POST[$key])
 225                   {
 226                         foreach($_POST[$key] as $var) #check positives against list
 227                         {
 228                                 if (array_key_exists($var, $negatives[$key]))
 229                                 {       #remove positives from list, leaving negatives
 230                                         unset($negatives[$key][$var]);
 231                                 }
 232                         }
 233                   }
 234                         if (is_array($negatives[$key]) && count($negatives[$key])>0)
 235                         {
 236                                 $neg = "Negative for ".implode(', ',$negatives[$key]).'.';
 237                         }
 238                 }
 239                 if (is_array($_POST[$key]) && count($_POST[$key])>0)
 240                 {
 241                         $pos = implode(', ',$_POST[$key]);
 242                 }
 243                 if($pos) {$pos = 'Positive for '.$pos.'.  ';}
 244                 $field_names[$key] = $pos.$neg;
 245         }
 246         else
 247         {
 248                 $field_names[$key] = $_POST[$key];
 249         }
 250         if ($field_names[$key] != '')
 251         {
 252 //          $field_names[$key] .= '.';
 253           $field_names[$key] = preg_replace('/\s*,\s*([^,]+)\./',' and $1.',$field_names[$key]); // replace last comma with 'and' and ending period
 254         }
 255 }
 256
 257 //end special processing
 258 foreach ($field_names as $k => $var) {
 259   #if (strtolower($k) == strtolower($var)) {unset($field_names[$k]);}
 260   $field_names[$k] = formDataCore($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 ) ENGINE=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 htmlspecialchars($obj{"$var"},ENT_QUOTES);
 311 }
 312 function chkdata_Date(&$obj, $var) {
 313         return htmlspecialchars($obj{"$var"},ENT_QUOTES);
 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="<?php echo $css_header;?>" type="text/css">
 328 </head>
 329 <body <?php echo $top_bg_line;?> topmargin=0 rightmargin=0 leftmargin=2 bottommargin=0 marginwidth=2 marginheight=0>
 330 DATE_HEADER
 331 <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()">
 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 my $template_file_name = $ARGV[0];
 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 #copy template file to form directory
 526
 527
 528
 529 #******************************************************************
 530 #************************* SUBROUTINES ***************************
 531 #******************************************************************
 532
 533 sub replace
 534 {
 535         my $text = shift;  #This shifts through the supplied arguments ($whatever_php, 'FORM_NAME', and $form_name)
 536                                 #This $text is a LOCAL variable.  Does not overwrite other $make_form_results
 537                                 #Shift starts with the first value.  If variable (as in $whatever_php) expands and goes through line by line
 538         my %words = @_;
 539         $text =~ s/$_/$words{$_}/g for keys %words;
 540         return $text;
 541 }
 542
 543
 544 sub replace_save_php #a special case
 545 {
 546         my $text = shift;
 547         my @fields = map {$_->[0]} grep{$_->[0] and $_->[1]} @_;  #Checks to see that Field_name and Field_type exist --Grep statement and map to @array.
 548         for (@fields)
 549         {
 550                  $_ = "$_='\".\$field_names[\"$_\"].\"'";
 551         }
 552         my $fields = join ',',@fields;
 553         $text =~ s/FIELDS/$fields/;
 554         @fields = ();
 555         my @negatives;
 556         for (@_)
 557         {
 558                 if ($_->[0] and $_->[1])
 559                 {
 560                         push @fields, "'$_->[0]' => '$_->[1]'";
 561                         if ($negatives{$_->[0]})
 562                         {
 563                                 my @temp;
 564                                 my $count = 3;
 565                                 while ($count < scalar(@$_))
 566                                 {
 567                                         push @temp, "'$_->[$count]' => '$_->[$count]'";
 568                                         $count++;
 569                                 }
 570                                 push @negatives, "'$_->[0]' => array(".join(',', @temp).")";
 571                         }
 572                 }
 573         }
 574         $fields = join ',', @fields;
 575         $text =~ s/FIELDNAMES/$fields/;
 576         my $negatives = join ',', @negatives;
 577         $text =~ s/NEGATIVES/$negatives/;
 578         return $text;
 579 }
 580
 581 sub replace_sql #a special case
 582 {
 583         my $text = shift;
 584         my $replace = '';
 585         for (grep{$_->[0] and $_->[1]} @_)
 586         {
 587           next if $_->[0] eq 'redirect';
 588           $replace .= $_->[0]." TEXT,\n" if $_->[1] !~ /^date$/;
 589           $replace .= $_->[0]." DATE,\n" if $_->[1] =~ /^date$/;
 590         }
 591         $text =~ s/DATABASEFIELDS/$replace/;
 592         return $text;
 593 }
 594
 595 sub replace_view_php           #a special case  (They're all special cases aren't they? ;^ )  )
 596 {
 597         my $text = shift;
 598         $text =~ s/(<\/label>)\s?(<label>)/$1\n$2/g;            #MAKE LAYOUT MORE READABLE. NEWLINE FOR EACH <LABEL> TAG
 599         my @text = split (/\n/,$text);                          #PUT EACH LINE OF TEXT INTO AN ARRAY SPLIT ON NEWLINE (\n)
 600         my @temp = ();
 601         my $selname = "";
 602         foreach (@text)
 603         {
 604                 if ($_ =~ /<select name="(\w*)/) #SELECT NAME FOR POPUP & SCROLLING MENUS.
 605                         {
 606                           $selname = $1;
 607                           goto go;
 608                         }
 609
 610           goto go if $_ =~ s/(<textarea\sname=")([\w\s]+)("[\w\s="]*>)/$1$2$3<?php \$result = chkdata_Txt(\$obj,"$2"); echo \$result;?>/;  #TEXTAREA
 611
 612           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
 613
 614           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
 615
 616           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
 617
 618           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
 619
 620           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
 621           goto go if $_ =~ s/(.*?)name='(.*?)'(.*?)datekeyup(.*?)dateblur(.*?)\/>/$1name='$2'$3datekeyup$4dateblur$5 value="<?php \$result = chkdata_Date(\$obj,"$2"); echo \$result;?>">/; #DATE
 622
 623                 go:     push (@temp, $_, "\n");
 624
 625         }
 626
 627         $text = "@temp";
 628         return $text;
 629 }
 630
 631
 632 sub make_form #MAKE_FORM
 633 {
 634         my @data = @_;
 635         my $return = submit(-name=>'submit form');
 636         $return .= '<br>'."\n";
 637         $return .= "\n".'<table>'."\n\n" if $bigtable;
 638         for (@data)
 639         {
 640                 next if not $_->[0];            #Go to next iteration of loop if no "field name"
 641                 next if $_->[0] =~ /^#/;        #ignore perl type comments
 642                 if ($_->[0] =~ /^\w/ and $_->[1])       #Check that the "field name" contains valid characters and that there is a "field type" in array iteration.
 643                 {
 644                         my $field_name = shift @$_;     #Get current field_name for iteration of array.  Shift removes it from the array and moves to next.
 645                         my $field_type = shift @$_;
 646                         my $label = $field_name;
 647                         $label =~ s/_/ /g;
 648                         $label = ucfirst($label);
 649                         $return .= "\n".'<table>'."\n\n" if not $bigtable;
 650                         if ($field_type =~ /^textfield$/)
 651                         {
 652                                 $return .= Tr(td($label),td(textfield(-name=>$field_name, -value=> join @$_)))."\n";
 653                         }
 654                         elsif ($field_type =~ /^textarea$/)
 655                         {
 656                                 $return .= Tr(td($label),td(textarea(-name=>$field_name, -rows=>4, -columns=>40, -value=> join @$_)))."\n";
 657                         }
 658                         elsif ($field_type =~ /^radio_group$/)
 659                         {
 660                                 $return .= Tr(td($label),td(radio_group(-name=>$field_name, -values=>$_, -default=>'-')))."\n";;
 661                         }
 662                         elsif ($field_type =~ /^checkbox$/)
 663                         {
 664                                 $return .= Tr(td($label),td(checkbox(-name=>$field_name, -value=>'yes', -label=> join @$_)))."\n";
 665                         }
 666                         elsif ($field_type =~ /^checkbox_group$/)
 667                         {
 668                                 $return .= Tr(td($label),td(checkbox_group(-name=>$field_name.'[]', -values=>$_)))."\n";
 669                         }
 670                         elsif ($field_type =~ /^popup_menu$/)
 671                         {
 672                                 $return .= Tr(td($label),td(popup_menu(-name=>$field_name, -values=>$_)))."\n";
 673                         }
 674                         elsif ($field_type =~ /^scrolling_list$/)
 675                         {
 676                                 $return .= Tr(td($label),td(scrolling_list(-name=>$field_name, -values=>$_, -size=>scalar(@$_))))."\n";
 677                         }
 678                         elsif ($field_type =~ /^scrolling_list_multiples/)
 679                         {
 680                                 $return .= Tr(td($label),td(scrolling_list(-name=>$field_name.'[]', -values=>$_, -size=>scalar(@$_), -multiple=>'true')))."\n";
 681                         }
 682                         elsif ($field_type =~ /^header/)
 683                         {
 684                                 $return .= Tr(td($label),td(hidden(-name=>$field_name, -value=>$field_name)))."\n";
 685                         }
 686                         elsif ($field_type =~ /^date$/)
 687                         {
 688 $date_field_exists = 1;
 689 $return .= <<"START";
 690 <tr><td>
 691 <span class='text'><?php xl('$label (yyyy-mm-dd): ','e') ?></span>
 692 </td><td>
 693 <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' />
 694 <img src='../../../interface/pic/show_calendar.gif' align='absbottom' width='24' height='22'
 695 id='img_$field_name' border='0' alt='[?]' style='cursor:pointer'
 696 title='Click here to choose a date'>
 697 <script>
 698 Calendar.setup({inputField:'$field_name', ifFormat:'%Y-%m-%d', button:'img_$field_name'});
 699 </script>
 700 </td></tr>
 701 START
 702                         }
 703                         elsif ($field_type =~ /^redirect/)
 704                         {
 705                                 #you could argue that this does not belong here and maybe more appropriately on the command line.
 706                                 #I just wanted to make it so redirect could be part of the template file and leverage existing functionality.
 707                                 @redirect = (@$_);
 708                                 my $formname = shift(@redirect);
 709                                 my $mainfield = shift(@redirect);
 710                                 my $field_constants;
 711                                 if (@redirect) {
 712                                         my %temp = @redirect;
 713                                         foreach(keys %temp) {
 714                                                 $field_constants .= "'$_' => '".$temp{$_}."', ";
 715                                         }
 716                                         $field_constants =~ s/, $/\)/;
 717                                         $field_constants = "array('$mainfield' => \$data,".$field_constants;
 718                                 } else {
 719                                         $field_constants = "array('$mainfield' => \$data)";
 720                                 }
 721 #                               my $t1 = "<tr><td><b>";
 722 #                               my $t2 = "</b></td></tr>";
 723 #                               my $t3 = "<tr><td>";
 724 #                               my $t4 = "</td>><td>";
 725 #                               my $t5 = "</tr></td>";
 726                                 my ($t1,$t2,$t3,$t4,$t5) = ('','','','','');
 727                                 $redirect_string = "\n}\n" .
 728 #                                       "\$data = \"<table>\\n\";\n" .
 729                                         "foreach (\$field_names as \$k => \$v) {\n" .
 730                                         "  if (\$k == \$v && \$v != '') {\/\/header\n" .
 731                                         "    \$data .= \"$t1\\n\\n\".\$k.\"$t2\\n\\n\";\n" .
 732                                         "  }\n" .
 733                                         "  elseif (\$v != '') {\n" .
 734                                         "    \$data .= \"$t3\".\$k.\": $t4\".\$v.\"$t5\\n\";\n" .
 735                                         "  }\n" .
 736                                         "}\n" .
 737 #                                       "\$data .= \"</table>\\n\";\n" .
 738                                         "\$newid = formSubmit(\"form_$formname\", $field_constants, \$_GET[\"id\"], \$userauthorized);\n" .
 739                                         "addForm(\$encounter, \"$formname\", \$newid, \"$formname\", \$pid, \$userauthorized);"
 740                         }
 741                         unshift @$_, $label;
 742                         unshift @$_, $field_type;
 743                         unshift @$_, $field_name;
 744                         $return .= "\n".'</table>'."\n" if not $bigtable;
 745                 }
 746                 elsif (!$bigtable) #probably an html tag or something -- Get to this point if no Field_name and Field_type found in array.
 747                 {
 748
 749                           if ($_->[0] !~ /<br>\s*$|<\/td>\s*$|<\/tr>\s*$|<\/p>\s*$/) {
 750                             $return .= '<br>'."\n";
 751                           }
 752
 753                           $return .= $_->[0]."\n";
 754
 755
 756                 }
 757         }
 758         $return .= "<table>" if not $bigtable;
 759         $return .= "</table>";
 760         $return .= submit(-name=>'submit form');
 761         return $return;
 762 }
 763
 764 #***********************************************************************************************************
 765 #**Receive 'full file path' and '$out' (finished output) from REPLACEMENT SECTION above and write to file.**
 766 #***********************************************************************************************************
 767
 768 sub to_file
 769 {
 770         my $filename = shift;
 771         my $string = shift;
 772         my $file;
 773         open $file, '>', $filename or die "cannot open $filename: $!";
 774         print $file $string;
 775         close $file or die "cannot close $filename: $!";
 776 }
 777 sub xl_fix #make compliant with translation feature
 778 {
 779         my $string = shift;
 780         return $string if $noxl;
 781         $string =~ s/(>{1,2})([^\s][^<>]+?)<\//$1 <\?php xl("$2",'e') \?> <\//gs;
 782         return $string;
 783 }
 784 sub xl_fix2 #make compliant with translation feature for report.php
 785 {
 786         my $string = shift;
 787         return $string if $noxl;
 788         $string =~ s/\.(\$\w+)\./\.xl("$1")\./gs;
 789         return $string;
 790 }