Piper's Pit BBS/FTP: ibm 0020 - 0029/ibm0020-0029/ibm0028.tar/ibm0028/SBTAR2.ZIP/SYSCMEN.PRG

Text File | 1990-06-04 | 5.4 KB | 188 lines

********************** ' MultiNet Source Code ' ***********************
** '                       SBT Corporation                         ' **
** '         One Harbor Drive, Sausalito, California 94965         ' **
** '                   Telephone [phone]                    ' **
***********************************************************************
** '   (c) Copyright 1984, Revisions 1985 - 1990 SBT Corporation   ' **
** '            All Rights Reserved by SBT Corporation             ' **
** '                                                               ' **
***********************************************************************
** ' 06/04/90 = Last Update  **  SYSCMEN.PRG  **   Version 6.35.00 ' **
***********************************************************************
* ' System wide company menu program, called by XX.PRG
*
IF TYPE('m0lntax') = 'U'
  RELEASE m0lntax
  PUBLIC m0lntax
  STORE .f. TO m0lntax
ENDIF
CLOSE DATABASES
SELECT a
USE &m0sysdr.sysdata
SET FILTER TO SUBSTR(sysid,1,2) = m0pgmid .AND. ;
SUBSTR(sysid,3,2) <> '  '  .AND. SUBSTR(pass2,1,1) <> 'D'
GO TOP
IF .NOT. EOF()
  STORE TRIM(SUBSTR(drive,61,30)) TO m0dbfdr
ELSE
  STORE '' TO m0dbfdr
ENDIF
SET ESCAPE ON
CLEAR
@ 1,1 SAY DTOC(m0date)
@ 1,40 - INT(LEN(m0system)/2) SAY m0system
@ 1,73 SAY mversion
@ 2,1 SAY SUBSTR(m0border,10,78)
@ 3,34 SAY 'Company Menu'
@ 5,6 SAY 'Number'
@ 5,17 SAY 'Company'
DO WHILE .t.
  STORE RECNO() TO mtop
  STORE 7 TO mline
  STORE 'Enter Company Number or (Q/A/D' TO msg
  STORE 'QAD' TO moptns
  IF SUBSTR(sysid,1,2) = m0pgmid .AND. .NOT. EOF()
    STORE STR(VAL(SUBSTR(a->sysid,3,2)),2,0) TO action
    STORE SUBSTR(LTRIM(action)+' ',1,2) TO action, mdefault
    DO WHILE SUBSTR(sysid,1,2) = m0pgmid .AND. mline < 20 .AND. .NOT. EOF()
      @ mline,8 SAY STR(VAL(SUBSTR(a->sysid,3,2)),2,0) + '.'
      @ mline,17 SAY TRIM(a->company)
      STORE mline + 1 TO mline
      SKIP
    ENDDO
    SKIP -1
    STORE RECNO() TO mrecno
    IF SUBSTR(sysid,1,2) = m0pgmid .AND. .NOT. EOF()
      SKIP
      IF SUBSTR(sysid,1,2) = m0pgmid .AND. .NOT. EOF()
        STORE msg + '/F' TO msg
        STORE moptns + 'F' TO moptns
      ENDIF
    ENDIF
    GO mtop
    SKIP -1
    IF SUBSTR(sysid,1,2) = m0pgmid .AND. .NOT. BOF()
      STORE msg + '/B' TO msg
      STORE moptns + 'B' TO moptns
    ENDIF
    GO mrecno
  ELSE
    @ 9,8 SAY "No Companies Exist.  Press 'A' to Add a Company..."
    STORE 'A ' TO action, mdefault
    STORE 'Enter Choice (Q/A' TO msg
    STORE 'QA' TO moptns
    STORE .t. TO mempty
  ENDIF && .NOT. EOF()
  @ 22,8 SAY "'Q'-Quit         'A'-Add a Company        " + ;
  "'D'-Delete a Company"
  @ 23,0
  DO CASE
    CASE 'F' $ moptns .AND. 'B' $ moptns
      @ 23,8 SAY "'F'-Forward to Next Screen     " + ;
      "'B'-Backward to Previous Screen"
    CASE 'F' $ moptns
      @ 23,8 SAY "'F'-Forward to Next Screen"
    CASE 'B' $ moptns
      @ 23,8 SAY "'B'-Backward to Previous Screen"
  ENDCASE
  STORE msg + ') ' TO msg
  @ 21,0
  DO WHILE .t.
    @ 21,8 SAY msg + SUBSTR(m0border,181,5) GET action PICTURE '!!'
    READ
    IF TRIM(LTRIM(action)) $ moptns
      EXIT
    ENDIF
    IF SUBSTR(action,1,1) $ moptns
      STORE SUBSTR(action,1,1) + ' ' TO action
      EXIT
    ENDIF
    IF VAL(action) > 0
      LOCATE FOR VAL(SUBSTR(sysid,3,2)) = VAL(action)
      IF .NOT. EOF()
        @ 21,0 CLEAR
        @ 21,8 SAY 'Loading Company ' + LTRIM(STR(VAL(action),2,0)) + ;
        ' Information.  Please wait...'
        STORE SUBSTR(printer,3,1) TO m0port
        EXIT
      ENDIF
    ENDIF
    STORE mdefault TO action
    ?? CHR(7)
  ENDDO && WHILE .t.
  DO CASE
    CASE .NOT. action $ ' F B '
      EXIT
    CASE action $ ' F '
      SKIP
    CASE action $ ' B '
      STORE 0 TO mcount
      GO mtop
      DO WHILE mcount < 13 .AND. .NOT. BOF()
        SKIP -1
        STORE mcount + 1 TO mcount
      ENDDO
      IF BOF()
        GO TOP
      ENDIF
  ENDCASE
  @ 7,0 CLEAR TO 20,78
ENDDO && WHILE .t.
* ' Deal with odd combinations such as 'AD' and 'QA'
IF 'Q' $ action
  STORE 'Q' TO action
ENDIF
IF 'A' $ action
  STORE 'A' TO action
ENDIF
SET FILTER TO
IF action $ ' D '
  CLEAR
  @ 1,1 SAY DTOC(m0date)
  @ 1,40 - INT(LEN(m0system)/2) SAY m0system
  @ 1,73 SAY mversion
  @ 2,1 SAY SUBSTR(m0border,10,78)
  @ 3,32 SAY 'Delete a Company'
  * ' We don't allow deletion when anyone else in in SBT systems
  DO p0sysmnt WITH .t.
  USE &m0sysdr.sysdata
  IF .NOT. mreturn
    STORE .f. TO mreturn
    RETURN
  ENDIF
  STORE 0 TO dcompany
  @ 6,6 SAY 'Enter Company Number to Delete or 0 to Cancel Deletion ' + ;
  SUBSTR(m0border,180,6)
  @ 6,69 GET dcompany PICTURE '##'
  READ
  CLEAR GETS
  IF dcompany = 0
    DO p0sysmnt WITH .f.
    STORE .f. TO mreturn
    RETURN
  ENDIF
  LOCATE FOR VAL(SUBSTR(a->sysid,3,2)) = dcompany .AND. ;
  SUBSTR(a->pass2,1,1) <> 'D' .AND. SUBSTR(a->sysid,1,2) = m0pgmid .AND. ;
  SUBSTR(a->sysid,3,2) <> '  '
  IF EOF()
    DO p0sysmnt WITH .f.
    STORE ' ' TO mans
    ?? CHR(7)
    @ 22,6 SAY 'Invalid Company Number.'
    @ 23,6 SAY 'Press any key to return to Company Menu...' GET mans
    READ
    CLEAR GETS
    STORE .f. TO mreturn
    USE &m0sysdr.sysdata
    RETURN
  ENDIF
ENDIF && action $ ' D '
RETURN
*
* ' $Revision:   1.10  $
* ' $Date:   29 May 1990 17:34:02  $
**********************
** ' SYSCMEN.PRG  ' **
** '  187 Lines   ' **
**********************