home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / database / pssst.zip / PSSST.PRG < prev    next >
Text File  |  1986-08-15  |  10KB  |  291 lines
  1. * PSSST.PRG
  2. *
  3. * A DBASE II 16BIT COMMAND FILE to set up the psssst system and
  4. * allow branching to the major branches of the PSSST system.
  5. *
  6. * Version 1
  7. * By LTC Denny Hugg
  8. * ANGSC/DOS Andrews AFB MD 16 Jul 1985
  9. *
  10. * Version 2
  11. * modified by Maj Jim McMurry
  12. * ANGSC/DOSC Truax Field, WI 15 Jun 1986
  13. *
  14. * Uses the g prefix for global variables
  15. *
  16. SET TALK OFF
  17. SET BELL OFF
  18. SET COLON OFF
  19. ERASE
  20. * --- gflag = 'Y' tells psprompt to put a box around the prompt
  21. *     which is the predominant mode
  22. STORE 'Y' TO gflag
  23. * --- create other global variables from info in PSCONFIG.MEM
  24. USE PSCONFIG.MEM
  25. IF .NOT. model$('ZIO')
  26. * --- the delete flag tells psconfig to return here
  27.    USE PSCONFIG.MEM
  28.    DELETE
  29.    USE
  30.    DO PSCONFIG
  31. ENDIF
  32. USE PSCONFIG.MEM
  33. STORE model TO gmodel
  34. STORE TRIM(firstname) TO gfirstname
  35. STORE INT((LEN(gfirstname)/2)+.5) TO gflength
  36. DO CASE
  37.    CASE delays = ' '
  38.       STORE 50 TO gdelay
  39.    CASE delays = 'S'
  40.       STORE 25 TO gdelay
  41.    CASE delays = 'M'
  42.       STORE 50 TO gdelay
  43.    CASE delays = 'L'
  44.       STORE 75 TO gdelay
  45. ENDCASE
  46. USE
  47. DO PSMENU
  48. * --- an empty string for clearing a specific line
  49. STORE $(STR(1,81),1,80) TO gclearline
  50. STORE '      ' TO gaddstring
  51. * --- beginning of light bar menu system
  52. * --- Available for separator line when affordable
  53. DO WHILE T
  54. * --- he's not on initial entry
  55.    IF gaddstring <> '      '
  56.       ERASE
  57.       STORE 'p S S S t   M A S T E R   M E N U' TO heading
  58.       DO PSHEADING
  59.    ENDIF
  60.    STORE chr(95)+chr(95) TO ln
  61.    STORE ln+ln+ln+ln+ln TO ln
  62.    STORE ln+ln+ln+ln+ln+ln+ln+ln TO ln
  63. * --- The Menu Items
  64.    STORE 'PHONE' TO p1
  65.    STORE 'JOB' TO p2
  66.    STORE 'PRIORITY' TO p3
  67.    STORE 'SUSPENSE' TO p4
  68.    STORE 'EXIT' TO p5
  69. * --- places spaces between menu items ... no inverse video.
  70. * --- leading space added to force lin to line 23 w/o jumping up.
  71. * --- 45 columns available.
  72.    STORE ' '+p1+'    '+p2+'    '+p3+'    '+p4+'    '+p5 TO lin
  73. * --- the prompts at right end of line 23 ... 35 columns available
  74.    STORE '                  (Rolodex System)' TO y1
  75.    STORE '     (Tracking And Editing System)' TO y2
  76.    STORE '               (Management System)' TO y3
  77.    STORE '    (Listing To Screen Or Printer)' TO y4
  78.    STORE '             (To Operating System)' TO y5
  79. * --- the columns at which the menu items are located
  80.    STORE '0009162840' TO col
  81.    STORE 1 TO c
  82.    STORE '1' TO z
  83.    STORE '0' TO mcho
  84.    STORE t TO screen
  85. * --- prompt elsewhere on screen if desired
  86.    @ 21,14 SAY 'Arrows Progress Through Menu ... <Return> To Select'
  87. * --- prints separator bar if affordable
  88.    @ 22,0 SAY gline
  89.    DO WHILE screen
  90. * --- displays menu items followed by current prompt
  91.       @ 22,79 SAY lin + y&z
  92. * --- hi-lites the current menu item
  93.       @ 23,VAL($(col,c,2)) GET p&z
  94.       CLEAR GETS
  95.       SET CONSOLE OFF
  96. * --- D and C returned by Z-100 arrow keys
  97. * --- K and M returned by Z-150 & IBM arrow keys
  98. * --- 4 and 6 used in case not in num-lock mode
  99.       STORE '0' TO mcho
  100.       DO WHILE ' '<>mcho .AND. .NOT. mcho$'DCKM46'
  101.          WAIT TO mcho
  102.       ENDDO
  103.       SET CONSOLE ON
  104.       DO CASE
  105.          CASE mcho$('CM6')
  106. * --- dependant on number of menu items
  107.             IF c#9
  108.                STORE c+2 TO c
  109.                STORE str(val(z)+1,1) TO z
  110.             ELSE
  111.                STORE 1 TO c
  112.                STORE '1' TO z
  113.             ENDIF
  114.          CASE mcho$('KD4')
  115.             IF c>1
  116.                STORE c-2 TO c
  117.                STORE str(val(z)-1,1) TO z
  118.             ELSE
  119. * --- dependant on number of menu items
  120.                STORE 9 TO c
  121. * --- dependant on number of menu items
  122.                STORE '5' TO z
  123.             ENDIF
  124. * --- ' ' returned by both return and space bars (unfortunately)
  125.          CASE mcho = ' '
  126.             STORE f TO screen
  127.             LOOP
  128.       ENDCASE
  129.    ENDDO
  130. * --- result is the column you're currently at
  131. * ----------------------------------------------------------------------*
  132. * ---------------------This Unique To PSSST-----------------------------*
  133. @ 21, 0 SAY gclearline
  134. @ 22, 0 SAY gclearline
  135. @ 22,79 SAY gclearline
  136. * --- otherwise he's on initial entry and wants to get out
  137. IF gaddstring = '      ' .AND. c<>9
  138. * --- he's on initial entry
  139.    USE PSCONFIG.MEM
  140.    * --- namestring is a character field, length 6 in PSCONFIG
  141.    IF namestring = '      '
  142.    * --- he's configured multi-user
  143.       STORE '               ' TO mfilename
  144.       @  0, 0 SAY gcuron
  145.       @ 22,18 SAY 'Type in your last name, please ' GET mfilename
  146.       READ NOUPDATE
  147.       @  0, 0 SAY gcuroff
  148.       @ 22,0 SAY gclearline
  149.       STORE TRIM(mfilename) TO mfilename
  150. * --- create a standard length filename for the guy
  151.       IF LEN(mfilename) < 6
  152.          STORE '000000' TO msixblnks
  153.          STORE $(mfilename,1,LEN(mfilename));
  154.              + $(msixblnks,1,6-LEN(mfilename)) TO mfilename
  155.          STORE $(mfilename,1,6) TO gaddstring
  156.       ELSE
  157.          STORE $(mfilename,1,6) TO gaddstring
  158.       ENDIF
  159.    ELSE
  160. * --- he's configured it for single user
  161.       STORE namestring TO gaddstring
  162.    ENDIF
  163. * --- create global variables for files and indexes
  164. * --- pssst uses the current year in the filename, this way when the year
  165. * --- changes, you're sent to PSNEWGUY to do some administrative stuff
  166.    STORE gaddstring + 'SP.0' + $(DATE(),7,2) TO gsusfile
  167.    STORE gaddstring + 'CM.0' + $(DATE(),7,2) TO gcomplfile
  168.    STORE gaddstring + 'DD.0' + $(DATE(),7,2) TO gdelfile
  169. * --- indexes named differently ... if the same as the dbf, they'll
  170. * --- eventually scramble things
  171.    STORE gaddstring + 'SI' TO gsusindex
  172.    STORE gaddstring + 'PI' TO gpryindex
  173. * --- convert DATE() to YY/MM/DD so indexing will order them
  174.    STORE VAL($(DATE(),1,2)) TO month
  175.    STORE VAL($(DATE(),4,2)) TO day
  176.    STORE VAL($(DATE(),7,2)) TO year
  177.    STORE STR(year,2) TO gdate
  178.    IF month > 9
  179.       STORE TRIM(gdate) + '/' + STR(month,2) + '/' TO gdate
  180.    ELSE
  181.       STORE gdate + '/0' + STR(month,1) + '/' TO gdate
  182.    ENDIF
  183.    IF day > 9
  184.       STORE gdate + STR(day,2) TO gdate
  185.    ELSE
  186.       STORE gdate + '0' + STR(day,1) TO gdate
  187.    ENDIF
  188. * --- check that today's date is later than last date used
  189. * --- last:day is a character field, length 8 in PSCONFIG.MEM
  190.    IF gdate < last:day
  191.       DO WHILE gdate < last:day
  192.          STORE gdate TO input
  193.          STORE 10 TO line
  194.          ERASE
  195.          STORE 'You Can Never Go Back ' + gfirstname TO prompt
  196.          DO PSPROMPT
  197.          ? gcuron
  198.          @ 22,19 SAY "You Need To Re-enter Today's Date ";
  199.                  GET input PICTURE '99/99/99'
  200.          READ
  201.          @  0, 0 SAY gcuroff
  202.          @  9, 0 SAY gclearline
  203.          @ 10, 0 SAY gclearline
  204.          @ 11, 0 SAY gclearline
  205.          IF input >= last:day
  206.             STORE input TO gdate
  207.          ENDIF
  208.       ENDDO
  209.    ENDIF
  210.    REPLACE last:day WITH gdate
  211.    USE
  212. * --- see if the guy already has a file - if not, make one
  213.    IF .NOT. FILE ("&gsusfile")
  214.      DO PSNEWGUY.PRG
  215.    ENDIF
  216. ENDIF
  217. *------------------------------------------------------------------------*
  218.    DO CASE
  219.       CASE c=1
  220.          RELEASE ALL EXCEPT g*
  221.          DO PSPHONE
  222.       CASE c=3
  223.          RELEASE ALL EXCEPT g*
  224.          DO PSJOBTRK
  225.       CASE c=5
  226.          RELEASE ALL EXCEPT g*
  227.          DO PSPRIORY
  228.       CASE c=7
  229.          RELEASE ALL EXCEPT g*
  230.          DO PSSUSPEN
  231.       CASE c=9
  232.          @ 22, 0 SAY gclearline
  233.          @ 22,79 SAY gclearline
  234.          * This backup procedure backs up the database sorted in the order
  235.          * according to the index file.  This speeds up future sequential
  236.          * movements of the record pointer.
  237.          IF gaddstring <> '      '
  238.             STORE ' ' TO select
  239.             @ 22,20 SAY 'Do You Wish To Back Up Your Data (Y/N) ';
  240.                     GET select PICTURE '!'
  241.             READ
  242.             @ 22, 0 SAY gclearline
  243.             IF select = 'Y'
  244.                USE PSCONFIG.MEM
  245.                IF back:drive = ' '
  246.                   STORE " :" TO drive
  247.                   @ 22,27 SAY "Drive Backup Disk Is On "
  248.                   @ 22,51 GET drive PICTURE "!:"
  249.                   READ
  250.                   @ 22, 0 SAY gclearline
  251.                ELSE
  252.                   STORE back:drive + ':' TO drive
  253.                   STORE 10 to line
  254.                   STORE 'Insert Your Backup Disk In Drive ' + drive TO prompt
  255.                   DO PSPROMPT
  256.                   STORE 22 TO line
  257.                   STORE 'N' TO gflag
  258.                   STORE '- Strike Any Key To Continue -' TO prompt
  259.                   DO PSPROMPT 
  260.                   STORE 'Y' TO gflag
  261.                   SET CONSOLE OFF
  262.                   WAIT
  263.                   SET CONSOLE ON
  264.                   @  9, 0 SAY gclearline
  265.                   @ 10, 0 SAY gclearline
  266.                   @ 11, 0 SAY gclearline
  267.                   @ 22, 0 SAY gclearline
  268.                ENDIF
  269.                @ 22,33 SAY "Backing Up ..."
  270.                * --- Back it up
  271.                USE &gsusfile INDEX &gsusindex
  272.                COPY TO &drive.&gsusfile
  273.                COPY TO &drive.&gcomplfile
  274.                COPY TO &drive.&gdelfile
  275.                USE
  276.             ENDIF
  277.          ENDIF
  278.          USE
  279.          ERASE
  280.          @  0, 0 say gcuron
  281.          QUIT
  282.       ENDCASE
  283.    STORE f TO screen
  284. ENDDO
  285. * --- end of light bar menu system
  286. * --- EOF PSSST.PRG
  287.     @ 22, 0 SAY gclearline
  288.          @ 22,79 SAY gclearline
  289.          * This backup procedure backs up the database sorted in the order
  290.          * according to the index file.  This speeds up future sequential
  291.          * movements of the record pointer.