***********************************************************************
* Program Name.........: dSCREEN.CMD/PRG
* Purpose..............: DATA ENTRY SCREEN CODE GENERATOR FOR dBASE II
* Author...............: MARK C. SCARAMELLA
*
* ====================================================================
*
* Copyright Notice.....: Copyright (C) 1984, Mark C. Scaramella
*                                            All rights reserved
*                        Released to the Public Domain
*                        Not for resale without the explicit permission
*                        of the author.  Modifications for personal
*                        use are authorized and encouraged.
*                        Please notify author of any improvements or
*                        fixes implemented or requested at:
*
*                          Mark C. Scaramella
*                      c/o ESD Corporation
*                          600 Meridian Ave.
*                          San Jose, CA  95126
*
*                        Telephone calls cannot be responded to,
*                        Letters only please.
*
*                        If you like dSCREEN and find it helpful and
*                        you would like to contribute to its "growth and
*                        development", please send a donation of $20.00
*                        (or more) to the above address.
*
* =======================================================================
*
* Date................: 1/27/85
* Version.............: 1.3 with high/low exclusion
*                           Date Fields,Req'd Fields,Calc Fields,Heading
*                           Date Reversal/Compression,Index Files,NOUP
* dBASE II Version....: 2.4 and up.  Should work with 2.3b, but not
*                       thoroughly tested under 2.3b (must remove NOUP
*                       command, SET DELETED ON command, must remark out/
*                       remove CASE statements which test for files.  or
*                       re-write them as IF statements which seem to work.)
* Updates under consideration:
*                       - Automatic Table lookup
*                       - Automatic Field/File Name validity checking
*                         in output command file.
*                       - Logical Field Support
* Comment/Notes.......: - Picture Clause and numeric fields don't
*                         work with underlines
*                       - Logical Field Types are not supported
*                         (Logical Fields will be flagged.)
*                       - Field Sequence defaults to record number
*                       - No checking for file existence except at
*                         start up.  This allows for automatic write-
*                         over of command files during generation.
*                       - Generator gets confused by 10 character
*                         field names becuase of "M" added for memory
*                         variables.  Avoid 10 character field names
*                         or... modify the command file output.
************************************************************************

set talk off
erase
?
?
?
? '                      - - d S C R E E N - -'
?
? '     AN AUTOMATIC COMMAND FILE GENERATOR FOR dBASE II DATA ENTRY'
?
? '                       by Mark Scaramella'
?
? '                      Version 1.3 01/27/85'
?
?
?
if .not. file('XSCREEN.dbf')
? CHR(7)+'Sorry, XSCREEN.DBF must be on the default disk for this program to run.'
? 'See program documentation/comments for details.'
? 'Re-start when XSCREEN.DBF is set up.'
cancel
endif
? '(P)revious or (N)ew Screen Data Base Definition File ? '
wait to ans
if !(ans)='N'
* STEP ONE: MAKE A DATABASE FILE FROM THE STRUCTURE OF THE SOURCE
* FILE USING THE PREVIOUSLY DEFINED FILE: XSCREEN.DBF WITH THE
* FOLLOWING CHARACTERISTICS:
*
*STRUCTURE FOR FILE:  D:XSCREEN .DBF
*NUMBER OF RECORDS:   00000
*DATE OF LAST UPDATE: 01/27/85
*PRIMARY USE DATABASE
*FLD       NAME      TYPE WIDTH   DEC
*001     FIELD:NAME   C    010
*002     ALIAS        C    030
*003     FIELD:TYPE   C    002
*004     FIELD:LEN    N    003
*005     FIELD:DEC    N    003
*006     SEQUENCE     N    002
*007     ROW          N    002
*008     ACOL         N    003
*009     FCOL         N    003
*010     CARRY        C    002
*011     DEFAULT      C    050
*012     PICTURE      C    050
*013     REQD         C    002
*014     FILL         C    002
*015     HIGH         C    010
*016     LOW          C    010
*017     FORMULA      C    050
*018     INDEX        C    002
*019     USED         C    002
*** TOTAL **             00239

ACCEPT "Enter database source file name " to dbfile
stor !(trim(dbfile)) to dbfile
DO CASE
  CASE DBFILE = " "
    cancel
  CASE .NOT. FILE("&DBFILE")
  ? CHR(7)+"FILE DOES NOT EXIST (on this drive)"
  ? "Please re-start."
  cancel
ENDCASE
use &dbfile
copy stru exte to stemp
use xscreen
if "."$dbfile
stor !($(dbfile,1,@(".",dbfile))+"dbs") TO dbscreen
else
stor !(dbfile+".dbs") TO dbscreen
ENDIF
acce 'Enter screen database file name to be created (Default: &dbscreen) ' to dbscrn
if dbscrn#" "
stor dbscrn to dbscreen
endif
copy stru to &dbscreen
use &dbscreen
appe from stemp
repl all sequence with #
dele file stemp
?
? '&dbscreen file created.  You may now edit &dbscreen (which is'
? 'in use now) with your screen characteristics.  Re-start this'
? 'Program after editing.  Use &dbscreen as the "(P)revious" file'
? 'when prompted.'
cancel
else

IF FILE("dscreen.cmd")
STOR "CMD" TO mtyp
ELSE
STOR "PRG" TO mtyp
ENDIF
* STEP TWO:
* SCREEN DATABASE FILE ALREADY EXISTS AND EDITED, READY FOR PROCESSING

? 'Screen database file with your screen characteristics (Default type .DBS) '
ACCE TO scrfile
IF .NOT."."$scrfile
STOR scrfile+".DBS" TO scrfile
ENDIF
DO CASE
  CASE SCRFILE = " "
    cancel
   CASE .NOT. FILE("&SCRFILE")
   ? CHR(7)+"FILE DOES NOT EXIST (on this drive)"
   ? "Please re-start."
   cancel
ENDCASE
use &scrfile
endif
go bott
stor $(str(0,81),1,80) to mbl
if #<20
  ACCE 'Enter Screen Heading ' to mshead
  stor $(mbl,1,(80-len(trim(mshead)))/2)+mshead to mshead
else
stor 'X' to mshead
endif
if #>22
?
? '*** More than 22 fields in screen database, some command file'
? 'modification will be required after it is generated.'
?
endif
* SEE IF USER HAS OVERRIDDEN @SAY/@GET POSITIONS IN THE SCREEN DATABASE
?
? 'Command file only?'
?
? '(Say yes at this point if you have entered new row'
? 'and column positions into the screen database file)'
?
wait to mcmdans
if !(mcmdans)="N"
  repl all acol with 1
* DETERMINE WIDEST FIELD ALIAS NAME
  INDE ON 100-LEN(TRIM(ALIAS)) TO ALEN
  GO TOP
* IGNORE UNUSED FIELDS
  DO WHILE !(USED)='N'
    SKIP
  ENDDO
  STOR LEN(TRIM(ALIAS)) TO AMAXLEN
  STOR 77-AMAXLEN TO FMAXLEN
  set inde to
  DELE FILE ALEN.NDX
  repl all used with 'N' for formula#' '
  INDE ON SEQUENCE TO SEQ
  GO TOP
  STOR 1 TO MCOL
  if mshead='X'
    stor 1 to mrow
  else
    stor 3 to mrow
  endif
  * FIRST LOOP CALCULATES ROW/COL POSITIONS AND CHECKS FOR DATE FIELDS
  DO WHILE .NOT. EOF
    IF !(USED)='N'
      SKIP
      LOOP
    ENDIF
    IF 'DATE'$!(FIELD:NAME).OR.'DATE'$!(ALIAS)
      repl field:type with 'D'
      REPL PICTURE WITH '99/99/99'
    ENDIF
    STOR LEN(TRIM(ALIAS))+FIELD:LEN TO TLEN
    REPL ROW WITH MROW,ACOL WITH MCOL
    REPL FCOL WITH AMAXLEN+1
    STOR MROW+1 TO MROW
    SKIP
  ENDDO

?
? 'Field characteristics generation complete.'
?
? 'Do you want to continue with command file generation?'
?
? '(Stopping now and restarting later will allow manual editing'
? 'of alias and field screen characteristics before re-starting.)'
?
wait to ans
if !(ans)='N'
  cancel
endif
endif
* NOW GENERATE THE COMMAND FILE
* DETERMINE THE WIDEST FIELD ALIAS NAME
INDE ON 100-LEN(TRIM(ALIAS)) TO ALEN
GO TOP
DO WHILE !(USED)='N'
SKIP
ENDDO
STOR LEN(TRIM(ALIAS)) TO AMAXLEN
STOR 77-AMAXLEN TO FMAXLEN
set inde to
DELE FILE ALEN.NDX
INDE ON SEQUENCE TO SEQ
GO TOP
ACCE 'Name of command file to be generated ' to cmdfile
?
acce 'Name of database file to be used ' TO mdbf
? 'Name index file(s) to be used (separated by commas) if applicable'
acce TO mndx
?
? 'Fill field entry area with (B)lanks or (U)nderlines ? '
wait to ans

IF .NOT."."$cmdfile
STOR CMDFILE+'.'+MTYP TO CMDFILE
ENDIF

set alte to &cmdfile
set alte on
Stor '...................................................' to mdots
go top
* GENERATE DRAFT PROGRAM DOCUMENTATION
? '***********************************************************************'
? '* Program Name.....: '+cmdfile
? '* Purpose..........: Data Entry For '+MDBF
IF mndx#" "
?? 'Index &mndx'
ENDIF
? '* Author...........: Your Name'
? '* Copyright Notice.: Copyright (C) 1985, Your Name, All rights reserved'
? '* Date.............: '+date()
? '* dBASE II version.: 2.4x'
? '* CMD file version : 1.0'
? '* Memory Variables.: "M"+Field names + control variables +...?'
? '* Comments/Notes...:                                           '
? '*                  :                                           '
? '***********************************************************************'
* SET "SETS" TO YOUR OWN TASTE
? '* ---- ENVIRONMENT SECTION:'
?
? '* Reset dBASE II with no active data bases and no memory variables'
? 'CLEAR'
? 'SET STEP OFF ".......... Obviously."'
? 'SET PRINT OFF "......... Obviously."'
? 'SET ECHO OFF ".......... Obviously (unless you want to see commands)"'
? 'SET TALK OFF ".......... Obviously (unless you want to see calculations)"'
? 'SET ALTERNATE OFF "..... Obviously."'
? 'SET ALTERNATE TO'
? 'SET BELL OFF ".......... Obviously.  The Bell implementation is useless"'
? 'SET CARRY OFF "......... This seems like a good default state"'
? 'SET COLON ON ".......... Important.  Not every screen has intensity"'
? 'SET CONFIRM OFF "....... Optional. You may want to default to ON."'
? 'SET CONSOLE ON "........ Obviously."'
? 'SET DEBUG OFF "......... Obviously."'
? 'SET DELETED ON "........ Optional. ON prevents DELETEd records from being"'
? '*                        included in a command with a scope (v. 2.4 only)'
? 'SET EJECT OFF "......... This eliminates Ejects before printout and"'
? '*                        requires an EJECT at the completion of a printout'
? 'SET ESCAPE OFF "........ Optional.  You may want to run with ESCAPE ON"'
? 'SET EXACT OFF "......... Optional (though usual default is OFF)"'
? 'SET FORMAT TO SCREEN ".. Obviously."'
? 'SET INTENSITY OFF "..... Different screens have different ways of"'
? '*                        presenting intensity.  It is good to start with'
? '*                        it off and control it.'
? 'SET LINKAGE OFF "....... Obviously."'
? 'SET RAW ON "............ Optional (though this is a good default position"'
? '*                        to prevent problems with semi-colons)'
? 'SET SCREEN ON "......... Obviously."'
? 'ERASE "................. Clear the screen"'
?
? '* Put 79 blanks in a global memory variable'
? 'STORE $(STR(0,80),1,79) TO gmbl'
?
? 'USE &mdbf'
IF !(ANS)='U'
? 'STOR "_____________________________________________________________" TO MBL80'
ELSE
? '* ---- MEMORY VARIABLE INITIALIZATION:'
?
? 'STOR $(STR(0,81),1,80) TO MBL80'
ENDIF
DO WHILE .NOT. EOF
if !(FIELD:TYPE)='L'
  ? '*** Logical Field types not yet supported, CMD/PRG file editing required'
  ? '*** Logical Field Name: '+Field:name
  REPL USED WITH 'N'
endif
IF !(USED)='N'
SKIP
LOOP
ENDIF
* SET UP DEFAULTS AND INITIALIZE VARIABLES
DO CASE
CASE FIELD:TYPE='C'
  * TRUNCATE VERY LONG FIELDS, TOO HARD TO HANDLE IN THIS SYSTEM
  * IF LONG FIELDS ARE REQUIRED, USE EDITOR ON COMMAND FILE AFTER
  * SUCCESSFUL CREATION/TEST.
  IF FIELD:LEN>FMAXLEN
    IF DEFAULT=' '
      ? '*** LONG FIELD NAME, SUBSTRING USED TO FIT'
      ? 'STOR $(MBL80,1,'+STR(FMAXLEN,3)+') TO M'+TRIM(field:name)
    ELSE
      ? '*** LONG FIELD NAME, SUBSTRING USED TO FIT'
      ? 'STOR $("'+TRIM(DEFAULT)+'"+MBL80,1,'+STR(FMAXLEN,3)+') TO M'+TRIM(field:name)
    ENDIF
  ELSE
    IF DEFAULT=' '
      ? 'STOR $(MBL80,1,'+STR(FIELD:LEN,3)+') TO M'+TRIM(field:name)
    ELSE
      ? 'STOR $("'+TRIM(DEFAULT)+'"+MBL80,1,'+STR(FIELD:LEN,3)+') TO M'+TRIM(field:name)
    ENDIF
  ENDIF
CASE FIELD:TYPE='N'
  IF VAL(DEFAULT)=0
    ? 'STOR 0 TO M'+TRIM(field:name)
  ELSE
    ? 'STOR '+trim(DEFAULT)+' TO M'+TRIM(field:name)
  ENDIF
CASE FIELD:TYPE='D'
  IF DEFAULT=' '
    ? 'STOR $(MBL80,1,'+STR(FIELD:LEN,3)+') TO M'+TRIM(field:name)
  ELSE
    ? 'STOR $("'+TRIM(DEFAULT)+'"+MBL80,1,'+STR(FIELD:LEN,3)+') TO M'+TRIM(field:name)
  ENDIF
ENDCASE
SKIP
ENDDO

GO TOP
? '* ----- SCREEN FORMAT INITIALIZATION:'
?
? 'ERASE'
* GENERATE @SAYS ONE TIME BEFORE STARTING GET LOOP
? 'SET INTE ON'
DO WHILE .NOT. EOF
IF !(USED)='N'
SKIP
LOOP
ENDIF
IF FCOL<=31
? '@ '+STR(ROW,2)+', '+STR(ACOL,2)+' SAY "'+$(TRIM(ALIAS)+MDOTS,1,FCOL)+':"'
ELSE
? '@ '+STR(ROW,2)+', '+STR(ACOL,2)+' SAY "'+$(TRIM(ALIAS)+MDOTS,1,LEN(TRIM(ALIAS))+2)+':"'
ENDIF
SKIP
ENDDO
* GENERATE LOOP START-UP STATEMENTS
? 'SET INTE OFF'
?
? 'GO BOTT'
? 'STOR #+1 TO MRECNO'
IF mndx#" "
? 'SET INDEX TO &mndx'
ENDIF
? 'STOR " " TO MOK'
? 'DO WHILE T'
? '  @ 23,68 SAY "REC NO:"+STR(MRECNO,4)'
if mshead#'X'
  ? '@ 1,1 say "&mshead"'
  ? '@ 2,1 say "==============================================================================="'
  ? '@ 22,1 say "==============================================================================="'
endif
* GENERATE @GETS/PICTURES
? '* ----- DATA INPUT SECTION:'
?
GO TOP
? 'SET INTE ON'
DO WHILE .NOT. EOF
IF !(USED)='N'
SKIP
LOOP
ENDIF
IF PICTURE=' '
? '  @ '+STR(ROW,2)+', '+STR(FCOL+2,2)+' GET M'+TRIM(field:name)
ELSE
? '  @ '+STR(ROW,2)+', '+STR(FCOL+2,2)+' GET M'+TRIM(field:name)+' PICT '+'"'+!(TRIM(PICTURE))+'"'
ENDIF
SKIP
ENDDO

* GENERATE READ AND END LOGIC
GO TOP
? '  READ NOUP'
? 'SET INTE OFF'
? '  @ 23,0 SAY $(STR(0,80),1,79)'
* GENERATE REQUIRED FIELD LOGIC
? '* ----- DATA VALIDATION SECTION:'
?
GO TOP
IF FIELD:TYPE='C'.OR.FIELD:TYPE='D'
? '  IF  M'+TRIM(field:name)+' # " "'
ELSE
? '  IF M'+TRIM(field:name)+'>0'
ENDIF
DO WHILE .NOT. EOF
IF !(REQD)='Y'
  IF FIELD:TYPE='C'.OR.FIELD:TYPE='D'
    ? '  IF M'+TRIM(FIELD:NAME)+' = " "'
  ELSE
    ? '  IF M'+TRIM(FIELD:NAME)+' = 0'
  ENDIF
  ? '    @ 23,10 SAY CHR(7)'
  ? '    @ 23,10 SAY "'+TRIM(ALIAS)+' IS A REQUIRED ENTRY, PLEASE RE-ENTER"'
  ? '    CLEAR GETS'
  ? '    LOOP'
  ? '  ENDIF'
ENDIF
IF !(FILL)='Y'
  IF FIELD:TYPE='C'.OR.FIELD:TYPE='D'
    ? '  IF " "$M'+TRIM(FIELD:NAME)
  ? '    @ 23,10 SAY CHR(7)'
    ? '    @ 23,10 SAY "'+TRIM(ALIAS)+' MUST BE COMPLETELY FILLED, PLEASE RE-ENTER"'
    ? '    CLEAR GETS'
    ? '    LOOP'
    ? '  ENDIF'
  ENDIF
ENDIF
SKIP
ENDDO
* GENERATE HIGH AND LOW LIMIT LOGIC
GO TOP
DO WHILE .NOT. EOF
IF HIGH=' '.AND.LOW=' '
SKIP
LOOP
ENDIF
IF HIGH=' '.AND.LOW#' '
IF FIELD:TYPE='C'.OR.FIELD:TYPE='D'
? '  IF M'+TRIM(FIELD:NAME)+' < "'+TRIM(LOW)+'"'
ELSE
? '  IF M'+TRIM(FIELD:NAME)+' < '+TRIM(LOW)
ENDIF
? '    @ 23,10 SAY CHR(7)'
? '    @ 23,10 SAY "'+TRIM(ALIAS)+' CANNOT BE BELOW '+TRIM(LOW)+', PLEASE RE-ENTER"'
? '    CLEAR GETS'
? '    LOOP'
? '  ENDIF'
ELSE
IF HIGH#' '.AND.LOW=' '
IF FIELD:TYPE='C'.OR.FIELD:TYPE='D'
? '  IF M'+TRIM(FIELD:NAME)+' > "'+TRIM(HIGH)+'"'
ELSE
? '  IF M'+TRIM(FIELD:NAME)+' > '+TRIM(HIGH)
ENDIF
? '    @ 23,10 SAY CHR(7)'
? '    @ 23,10 SAY "'+TRIM(ALIAS)+' CANNOT BE ABOVE '+TRIM(HIGH)+', PLEASE RE-ENTER"'
? '    CLEAR GETS'
? '    LOOP'
? '  ENDIF'
ELSE
IF FIELD:TYPE='C'.OR.FIELD:TYPE='D'
? '  IF M'+TRIM(FIELD:NAME)+' < "'+TRIM(LOW)+'"'
ELSE
? '  IF M'+TRIM(FIELD:NAME)+' < '+TRIM(LOW)
ENDIF
? '    @ 23,10 SAY CHR(7)'
? '    @ 23,10 SAY "'+TRIM(ALIAS)+' CANNOT BE BELOW '+TRIM(LOW)+', PLEASE RE-ENTER"'
? '    CLEAR GETS'
? '    LOOP'
? '  ENDIF'
IF FIELD:TYPE='C'.OR.FIELD:TYPE='D'
? '  IF M'+TRIM(FIELD:NAME)+' > "'+TRIM(HIGH)+'"'
ELSE
? '  IF M'+TRIM(FIELD:NAME)+' > '+TRIM(HIGH)
ENDIF
? '    @ 23,10 SAY "'+TRIM(ALIAS)+' CANNOT BE ABOVE '+TRIM(HIGH)+', PLEASE RE-ENTER"'
? '    CLEAR GETS'
? '    LOOP'
? '  ENDIF'
ENDIF
ENDIF
SKIP
ENDDO
? 'ENDIF'
? '  SET INTE ON'
? '  @ 23,50 SAY "ALL OK? (*=QUIT)" GET MOK PICT "!"'
? '  READ NOUP'
? '  SET INTE OFF'
? '* ----- END PROCESSING SECTION:'
?
? '  IF MOK="*"'
? '    CLEA'
? '    SET TALK ON'
? '    RETURN'
? '  ENDIF'
? '  IF MOK#"Y"'
? '    @ 23,0 SAY $(STR(0,80),1,79)'
? '    LOOP'
? '  ENDIF'
? '  CLEAR GETS'
? '    @ 23,0 SAY $(STR(0,80),1,79)'
? '  APPE BLANK'
? '  STOR mrecno+1 TO mrecno'
* GENERATE REPLACE STATEMENTS
? '* ----- DATA BASE UPDATE SECTION:'
GO TOP
DO WHILE .NOT. EOF
IF !(USED)='N'.OR.(FORMULA#' '.AND.FIELD:TYPE='N')
  IF !(USED)='N' .AND. FORMULA=' '
    SKIP
    LOOP
  ELSE
    ? 'REPL '+TRIM(FIELD:NAME)+' WITH '+TRIM(FORMULA)
    SKIP
    LOOP
  ENDIF
ENDIF
DO CASE
CASE FIELD:TYPE='C'
IF !(ANS)='U'
? '  IF M'+TRIM(FIELD:NAME)+'#"_"'
? '    REPL '+TRIM(FIELD:NAME)+' WITH $(M'+TRIM(FIELD:NAME)+',1,@("_",M'+TRIM(FIELD:NAME)+')-1)'
? '  ELSE'
? '    REPL '+TRIM(FIELD:NAME)+' WITH M'+TRIM(FIELD:NAME)
? '  ENDIF'
ELSE
? '  REPL '+TRIM(FIELD:NAME)+' WITH M'+TRIM(FIELD:NAME)
ENDIF
CASE FIELD:TYPE='N'
? '  REPL '+TRIM(FIELD:NAME)+' WITH M'+TRIM(FIELD:NAME)
CASE FIELD:TYPE='D'
? '* DATE FIELD REVERSAL AND COMPRESSION'
? '  REPL '+TRIM(FIELD:NAME)+' WITH $(M'+TRIM(FIELD:NAME)+',7,2)+$(M'+TRIM(FIELD:NAME)+',1,2)+$(M'+TRIM(FIELD:NAME)+',4,2)'
ENDCASE
IF !(INDEX)#'Y'
?? ' NOUP'
ENDIF
SKIP
ENDDO
* GENERATE AND HANDLE DEFAULTS AND CARRY FEATURES
? '* -----  MEMORY VARIABLE UPDATE SECTION:'
?
GO TOP
DO WHILE .NOT. EOF
IF !(USED)='N'
SKIP
LOOP
ENDIF
IF FIELD:TYPE='C'.OR.FIELD:TYPE='D'
IF !(CARRY)='N'.OR.CARRY=' '
IF FIELD:LEN>FMAXLEN
? '  *** LONG FIELD NAME, SUBSTRING USED TO FIT'
? '  STOR $(MBL80,1,'+STR(FMAXLEN,3)+') TO M'+TRIM(FIELD:NAME)
ELSE
? '  STOR $(MBL80,1,'+STR(FIELD:LEN,3)+') TO M'+TRIM(FIELD:NAME)
ENDIF
ENDIF
IF DEFAULT#' '
? '  STOR $("'+TRIM(DEFAULT)+'"+MBL80,1,'+STR(FIELD:LEN,3)+') TO M'+TRIM(FIELD:NAME)
ENDIF
ELSE
IF DEFAULT#' '
? '  STOR '+STR(VAL(DEFAULT),FIELD:LEN)+' TO M'+TRIM(FIELD:NAME)
ELSE
? '  STOR 0 TO M'+TRIM(FIELD:NAME)
ENDIF
ENDIF
SKIP
ENDDO

? 'ENDDO'
SET ALTE OFF
SET ALTE TO
set inde to
DELE FILE SEQ.NDX
SET TALK ON
CLEA
CANCEL


