Oakland CPM Archive/oakcpm.iso/sigm/vol285/add.prg

Text File | 1986-12-22 | 4.4 KB | 159 lines

**    Last revision: April 17, 1986 at 18:54
* add.prg
* erase old screen
CLEA
STOR .t. TO first
STOR .t. TO more
SET DELIMITER OFF
DO WHIL more
 IF first
  DO s_first
  STOR .f. TO first
 ENDI
 SET COLOR TO &revvideo
 @ 19,00
 @ 19,10 SAY "ADD RECORDS MENU  - WHEN DONE ADDING HIT CONTROL 'Q' or 'W'"
 SET COLOR TO &stdvideo
 STOR SPACE(25) TO mlastname
 STOR SPACE(20) TO mfname
 STOR SPACE(15) TO mspouse
 STOR SPACE(14) TO mmr
 STOR SPACE(35) TO mtitle
 STOR SPACE(35) TO mcompany1
 STOR SPACE(35) TO mcompany2
 STOR SPACE(35) TO mcaddress
 STOR SPACE(10) TO msuite
 STOR SPACE(20) TO mccity
 STOR SPACE(2) TO mcst
 STOR SPACE(10) TO mczip
 STOR SPACE(35) TO maddress
 STOR SPACE(10) TO mapt
 STOR SPACE(20) TO mcity
 STOR SPACE(2) TO mst
 STOR SPACE(10) TO mzip
 STOR SPACE(13) TO mophone
 STOR SPACE(13) TO mphone
 STOR SPACE(22) TO mdear
 STOR SPACE(1) TO msend
 STOR SPACE(1) TO mcs1
 STOR SPACE(4) TO mcs2
 STOR SPACE(8) TO mupdate
 IF SUBSTR(DTOC(DATE()),1,2) <> '00' .AND. mupdate =  '  '
  STOR DTOC(DATE()) to mupdate
 ENDI
 @ 3,13 GET mlastname PICTURE '!XXXXXXXXXXXXXXXXXXXXXXXX'
 @ 3,58 GET mfname PICTURE '!XXXXXXXXXXXXXXXXXXX'
 @ 4,13 GET mspouse
 @ 4,58 GET mmr
 @ 6,13 GET mtitle
 @ 7,13 GET mcompany1
 @ 8,13 GET mcompany2
 @ 9,13 GET mcaddress
 @ 9,58 GET msuite
 @ 10,13 GET mccity
 @ 10,44 GET mcst picture '!!'
 @ 10,58 GET mczip picture '!!!!!!!!!!'
 @ 12,13 GET maddress
 @ 12,58 GET mapt
 @ 13,13 GET mcity
 @ 13,44 GET mst picture '!!'
 @ 13,58 GET mzip picture '!!!!!!!!!!'
 @ 14,21 GET mophone picture '[phone]'
 @ 14,58 GET mphone picture '[phone]'
 @ 15,13 GET mdear
 @ 15,58 GET msend picture '!'
 @ 16,13 GET mcs1 PICTURE '!'
 @ 16,44 GET mcs2 PICTURE '!!!!'
 @ 16,58 GET mupdate picture '99/99/99'
 READ
 CLEA GETS
 IF mlastname <> ' '
  DO check
  SET DELIMITER ON
  STOR 'N' TO command
  @ 20,00
  @ 21,00
  @ 22,00
  @ 23,00
  @ 20,15 SAY 'Are there any more changes ?                        '
  @ 20,48 GET command picture '!'
  READ
  @ 20,00
  SET DELIMITER OFF
  IF command = 'Y'
   @ 3,13 GET mlastname PICTURE '!XXXXXXXXXXXXXXXXXXXXXXXX'
   @ 3,58 GET mfname PICTURE '!XXXXXXXXXXXXXXXXXXX'
   @ 4,13 GET mspouse
   @ 4,58 GET mmr
   @ 6,13 GET mtitle
   @ 7,13 GET mcompany1
   @ 8,13 GET mcompany2
   @ 9,13 GET mcaddress
   @ 9,58 GET msuite
   @ 10,13 GET mccity
   @ 10,44 GET mcst PICTURE '!!'
   @ 10,58 GET mczip picture '!!!!!!!!!!'
   @ 12,13 GET maddress
   @ 12,58 GET mapt
   @ 13,13 GET mcity
   @ 13,44 GET mst PICTURE '!!'
   @ 13,58 GET mzip picture '!!!!!!!!!!'
   @ 14,21 GET mophone picture '[phone]'
   @ 14,58 GET mphone picture '[phone]'
   @ 15,13 GET mdear
   @ 15,58 GET msend picture '!'
   @ 16,13 GET mcs1 PICTURE '!'
   @ 16,44 GET mcs2 PICTURE '!!!!'
   @ 16,58 GET mupdate picture '99/99/99'
   READ
   CLEA GETS
   DO check
  ENDI command = 'Y'
  APPE BLANK
  REPL lastname WITH mlastname, fname WITH mfname
  REPL spouse WITH mspouse, mr WITH mmr
  REPL title WITH mtitle, company1 WITH mcompany1
  REPL company2 WITH mcompany2, caddress WITH mcaddress
  REPL suite WITH msuite, ccity WITH mccity
  REPL cst WITH mcst, czip WITH mczip
  REPL address WITH maddress, apt WITH mapt
  REPL city WITH mcity, st WITH mst
  REPL zip WITH mzip, ophone WITH mophone
  REPL phone WITH mphone, dear WITH mdear
  REPL send with msend
  REPL cs1 WITH mcs1, cs2 WITH mcs2, update WITH mupdate
  REPL new WITH .t.
  STOR .t. TO more
  @ 3,12 SAY SPACE(25)
  @ 3,57 SAY space(20)
  @ 4,12 SAY SPACE(15)
  @ 4,58 SAY SPACE(14)
  @ 6,12 SAY SPACE(35)
  @ 7,12 SAY SPACE(35)
  @ 8,12 SAY SPACE(35)
  @ 9,12 SAY SPACE(35)
  @ 9,58 SAY SPACE(10)
  @ 10,12 SAY SPACE(20)
  @ 10,44 SAY SPACE(2)
  @ 10,58 SAY SPACE(10)
  @ 12,12 SAY SPACE(35)
  @ 12,58 SAY SPACE(10)
  @ 13,12 SAY SPACE(20)
  @ 13,44 SAY SPACE(2)
  @ 13,57 SAY SPACE(10)
  @ 14,20 SAY SPACE(13)
  @ 14,58 SAY SPACE(13)
  @ 15,12 SAY SPACE(22)
  @ 15,58 SAY SPACE(1)
  @ 16,12 SAY SPACE(1)
  @ 16,44 SAY SPACE(5)
  @ 16,58 SAY SPACE(8)
 ELSE
  STOR .f. TO more
 ENDI there is an empty record
ENDD while more
SET DELIMITER ON
STOR .t. TO first
RETU