;SAMPLE program that demonstrates various TAS commands
;(this program was used to install a 1998 payroll update for Advanced Accounting

#udx                     &&allow user defined functions/commands
#lib \tas51\tasrtns      &&call a library file to access functions/commands
setup_color              &&user defined command contains in the library
color array norm
clrscr                   &&clear the screen

if windows()
    msg 'This installation program needs to be run in DOS mode. ' windows 'W'
    quit
endif

**************define program variables************
define fileloc_hndl type i
define location type A size 40 array 99   && file location array - up to 99 companies!
define code type A size 3 array 99        && company code array - up to 99 companies!
define I type i size 3
define drive type A size 2
define askmsg type A size 75
define fd_name type a size 8
define file_name, create_file type a size 60
define choice type I size 3

************open files************************
openv 'fileloc' lock N fnum fileloc_hndl

***************output to the screen****************************************
;simpler way is to mount a screen created with the TAS screen painter 
pmsg '   1998 PAYROLL UPDATE FOR ADVANCED ACCOUNTING 5.1 INSTALLATION PROGRAM' at 5,2 ptw S
pmsg '     Copyright 1995-8 ADDSUM BUSINESS SOFTWARE,INC.  801-277-9240' at 5,3 ptw S
pbox D at 1,1 len 4 wdt 79
pmsg '' ptw S
pmsg '  Current path is ',cpath() ptw S
pmsg '' ptw S


if ffile('pr98.EXE','f')<>''
   ask 'It appears that the PR98.EXE file is in your current subdirectory path.  Is that correct? Y'
   if ask()
     drive=""
     choice=3
     goto PROCEED
   endif
endif


CHOOSE:
;menu list options
nmenu ' Drive A: ',' Drive B: ',' EXE file download',' eXit' at 26,10 len 6 nch 4 wdt 35 box 's' bcolor bc mcolor mc ccolor cc cntr choice shd 'r' scolor sc ttlw 'l' ttl ' Where is the payroll update? ' auto
if choice=0 then quit
select choice
 case 1
  drive = "A:"
 case 2
  drive = "B:"
 case 3
  drive = ""
 case 4
  quit

endc

PROCEED:
ask 'Are you ready to proceed? Y'
if .n. ask() then quit


;make sure this is the correct diskette
if ffile(trim(drive,'t')+'pr98.EXE','f')<>''
    if choice < 3
      saves
      msg 'Copying files - please wait!' NOWAIT
      exec 'Copy' with drive + '*.* > nul'
      redsp
    endif
else
    ask 'Cannot find the PR98.EXE file.  Try again? Y'
    if ask() goto CHOOSE
    quit
endif


I=0
;access/search through the file - scan through a Btrieve file named FILELOC.B
;used by TAS to keep track of file names, descriptors, type and path
scan @fileloc_hndl key loc_file_name start 'BKSYMSTR' while loc_file_name='BKSYMSTR'
  I=I+1
  location[I]=loc_location
  code[I]=loc_comp_code
ends

if I=0
  msg 'No BKSYMSTR files were found - please call for support.' windows 'W'
  quit
endif

clr @fileloc_hndl buff

if ffile('pr98.exe','F')<> '' 
   ;file is here
   msg 'When you are asked if you want to overwrite, press letter A (for [A]ll).  Press a key to continue.' windows 'info'
   saves
   clrscr
   exec 'PR98.EXE'   &&extract the files that cames with this program in PR98
   redsp
else
   msg 'Could not find file PR98.EXE - perhaps it did not copy in successfully.  This program will now end.' windows 'info'
   quit
endif


gosub menu_ary     &&call subroutine in this program

saves              &&save the screen buffer
chain 'newmerge'   &&run an external TAS program (file would be NEWMERGE.RUN)
redsp              &&redisplay the screen buffer

delf 'pr98.exe'    &&delete the extract file

if choice < 3      &&if choice was 3 we ran pr98.run from this directory so can't delete it automatically
  delf 'pr98.run'
endif

msg 'Installation is complete. ' windows 'info'
 
clrscr
quit 0             &&quits back to the prompt/desktop instead of staying in TAS environment



NO_SYMSTR:
msg 'No BKSYMSTR record was found.  Please call for support.' windows 'W'
quit

INIT_FILE:
  create_file = location[cntr]*file_name*+"."+code[cntr]
  pmsg 'Creating file ',create_file at 10,18 ptw S NOCR
  chain  'initbtrv' with FD_NAME, CREATE_FILE     &&calls external program passing values
  ret


;SUBROUTINE which opens a TEXT file, puts all of its contents in memory
;inserts text into that file and re-writes it to a disk (one of several
;ways to do this) - note that we use the same sort of commands on non-Btrive
;files that we do with Btrieve files
menu_ary:

define menu_hndl type I
define cntr, max,row type I size 3
;buffer and data sizes need to match the size option in the openv command below
define buffer type A size 82 array 500
define DATA, LINE type A size 82

openv 'bkmenu.ary' fnum menu_hndl type X size 82 buff DATA   &&open menu TEXT file
findv F fnum menu_hndl key @1 err FILE_ERROR

;read records into the buffer array
for(cntr;1;500;1)

  if mid(data,1,24)="1,G - Print W-2s,bkprg,7" 
      DATA="1,G - Print W-2s & W-2 History,bkprg,7"  &&change this line
  endif

  BUFFER[cntr] = DATA

  ;see if we are at the place where we want to insert items into the
  ;buffer

  if mid(buffer[cntr],1,2)="\\" 
      max=cntr
      goto WRITE_FILE
  endif

  findv N fnum menu_HNDL key @1 err WRITE_FILE
next


WRITE_FILE:
    close @MENU_HNDL
    if ffile('bkmenu.arz','F')<> '' DO
        delf 'bkmenu.arz'
    endif
    renf 'bkmenu.ary' to 'bkmenu.arz'
   
    trap PG_BRK IGNR

    openv 'BKMENU' fnum menu_hndl type X ext 'ARY' size 82 buff data CREATE
    wrta buffer[cntr] to data maxa max cntr cntr file @MENU_HNDL


DO_WINFILE:

;AJF clear the buffer!
updta buffer clr times 500

;do the same thing for the WINDOWS BKMENUW.ARY file
openv 'bkmenuw.ary' fnum menu_hndl type X size 82 buff DATA
findv F fnum menu_hndl key @1 err FILE_ERROR


for(cntr;1;500;1)

  if mid(data,1,24)="1,G - Print W-2s,bkprg,7" 
      DATA="1,G - Print W-2s & W-2 History,bkprg,7"  &&change this line
  endif

  BUFFER[cntr] = DATA

  ;see if we are at the place where we want to insert items into the
  ;buffer
  if mid(buffer[cntr],1,2)="\\" 
     max=cntr     
     goto WIN_WRITE_FILE
  endif
  findv N fnum menu_HNDL key @1 err WIN_WRITE_FILE
next


WIN_WRITE_FILE:
    close @MENU_HNDL
    if ffile('bkmenuw.arz','F')<> '' DO
        delf 'bkmenuw.arz'
    endif

    renf 'bkmenuw.ary' to 'bkmenuw.arz'

    
    trap PG_BRK IGNR

    openv 'BKMENUW' fnum menu_hndl type X ext 'ARY' size 82 buff data CREATE
    wrta buffer[cntr] to data maxa max cntr cntr file @MENU_HNDL



EXIT:
    msg 'Your prior menu files BKMENU.ARY and BKMENUW.ARY have been renamed BKMENU.ARZ and BKMENUW.ARZ in the event they are needed.  You will need to ESC and come back into the software before you will see the menu changes!' windows 'info'
ret

FILE_ERROR:

msg 'An error has occurred while trying to read BKMENU.ARY.' windows 'W'
ret

;End of Program