home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol285 / proc.prg < prev    next >
Encoding:
Text File  |  1986-12-22  |  3.0 KB  |  111 lines
  1. **    Last revision: June 18, 1986 at 22:23
  2. * proc.prg  procedure file
  3. PROC s_first
  4.  CLEA
  5.  @ 3, 3 SAY "Lastname:"
  6.  @ 3,46 SAY "First & MI:"
  7.  @ 4, 5 SAY "Spouse:"
  8.  @ 4,46 SAY "Address as:"
  9.  @ 6, 6 SAY "Title:"
  10.  @ 7, 1 SAY "Company #1:"
  11.  @ 8, 9 SAY "#2:"
  12.  @ 9, 0 SAY "Co. Address:"
  13.  @ 9,51 SAY "Suite:"
  14.  @ 10, 7 SAY "City:"
  15.  @ 10,36 SAY "State:"
  16.  @ 10,53 SAY "Zip:"
  17.  @ 12, 2 SAY "Home Addr:"
  18.  @ 12,53 SAY "Apt:"
  19.  @ 13, 7 SAY "City:"
  20.  @ 13,36 SAY "State:"
  21.  @ 13,53 SAY "Zip:"
  22.  @ 14, 2 SAY "Telephone  Office:"
  23.  @ 14,46 SAY "Home phone:"
  24.  @ 15, 1 SAY "Salutation:"
  25.  @ 15,42 SAY "Send to office:"
  26.  @ 16,07 SAY "List:"
  27.  @ 16,37 SAY "Code:"
  28.  @ 16,50 SAY "Update:"
  29. RETU
  30. PROC check
  31. TSTATE = "AKALARAZCACOCTDCDEFLGAHIIAIDILINKSKY";
  32.          +"LAMAMDMEMIMNMOMSMTNCNDNENHNJNMNVNYOH";
  33.          +"OKORPARISCSDTNTXUTVAVTWAWIWVWY  " 
  34.  DO CASE
  35.  CASE mfname = ' '
  36. * no firstname
  37.   STOR .t. TO error
  38.  CASE mmr = ' '
  39. * no mister
  40.   STOR .t. TO error
  41. * bad state
  42.  CASE MOD(AT(mcst,'&tstate'),2) = 0
  43.   STOR .t. TO error
  44.  CASE MOD(AT(mst,'&tstate'),2) = 0
  45.   STOR .t. TO error
  46.  CASE mdear = ' '
  47. * no salutation
  48.   STOR .t. TO error
  49.  CASE .NOT. (msend = 'Y' .OR. msend = 'N')
  50. * no send command
  51.   STOR .t. TO error
  52.  OTHE
  53.   STOR .f. TO error
  54.  ENDC
  55. * if test for error was true then fix the fields that need fixing
  56.  IF error
  57.   IF .NOT. clipper
  58.   SET COLOR TO &revvideo
  59.   ENDIF
  60.   @ 20,01 SAY SPACE(77)
  61.   @ 20,24 SAY 'Please correct indicated data.'
  62.   IF .NOT. clipper
  63.   SET COLOR TO &stdvideo
  64.   ENDI 
  65.   STOR .t. to an_error
  66.   DO WHIL an_error
  67.    DO CASE
  68.    CASE mfname = ' '
  69.     @ 21,01 SAY SPACE(77)
  70.     @ 22,01 SAY SPACE(77)
  71.     @ 21,15 SAY 'You must have a first name or initial'
  72.     @ 3,58 GET mfname PICTURE '!XXXXXXXXXXXXXXXXXXX'
  73.     READ
  74.    CASE mmr = ' '
  75.     @ 21,01 SAY SPACE(77)
  76.     @ 22,01 SAY SPACE(77)
  77.     @ 21,15 SAY 'Must have Mr., Mrs. Miss, Ms., Dr. Hon., etc.'
  78.     @ 04,58 GET mmr
  79.     READ
  80.    CASE mdear = ' '
  81.     @ 21,01 SAY SPACE(77)
  82.     @ 22,01 SAY SPACE(77)
  83.     @ 21,15 SAY 'Must have a salutation for Dear..... '
  84.     @ 15,13 GET mdear
  85.     READ
  86.   CASE MOD(AT(mcst,'&tstate'),2) = 0
  87.     @ 21,01 SAY SPACE(77)
  88.     @ 22,01 SAY SPACE(77)
  89.     @ 21,15 SAY 'Company state abbreviation not correct'
  90.     @ 10,44 GET mcst PICTURE '!!'
  91.     READ
  92.   CASE MOD(AT(mst,'&tstate'),2) = 0
  93.     @ 21,01 SAY SPACE(77)
  94.     @ 22,01 SAY SPACE(77)
  95.     @ 21,15 SAY 'Home state abbreviation not correct '
  96.     @ 13,44 GET mst PICTURE '!!'
  97.     READ
  98.    CASE .NOT. (msend = 'Y' .OR. msend = 'N')
  99.     @ 21,01 SAY SPACE(77)
  100.     @ 22,01 SAY SPACE(77)
  101.     @ 21,15 SAY 'Must answer "Y" or "N" to send letter to office   '
  102.     @ 15,58 GET msend picture '!'
  103.     READ
  104.    OTHE
  105.     STOR .f. TO an_error
  106.    ENDC
  107.   ENDD while an:error
  108.  ENDI error
  109. RETU
  110. 
  111.