*--------------------------*
* TABLE
* GENERIC TABLE MAINTENANCE PROGRAM TO UPDATE CLOCK TABLES.
*--------------------------*
CS=@(-1) ; CR=@(-3) ; CL=@(-4) ; RV=@(-13) ; ERV=@(-14)
VM=CHAR(253) ; SVM=CHAR(252) ; AM=CHAR(254) ; BEEP=CHAR(7)
PF1='<' ; PF2='P' ; PF3='/'
FF=CHAR(12)
LF=CHAR(10):CHAR(13)
PROMPT ""
MODE=''
HD=''; LN=''; LNCT=0
COL=0; POS=0; MAX=20
LAYOUT=''
GOSUB 10000 ;* SETUP LAYOUT ARRAY
*
FILENAME='STATUS.WORKORDER'
OPEN FILENAME TO OFILE ELSE ABORT
EXECUTE \SSELECT \:FILENAME
BRAY=''
LOOP
 READNEXT KEY ELSE KEY='EOF'
UNTIL KEY='EOF' DO
 BRAY=INSERT(BRAY,1,-1;KEY)
REPEAT
*
100 *
GOSUB 2100
BCT=DCOUNT(BRAY<1>,VM)
B=0
LOOP
 B=B+1
 KEY=BRAY<1,B>
UNTIL B > BCT DO
 READ IREC FROM OFILE,KEY THEN
  IREC=INSERT(IREC,1;KEY)
  OREC=IREC
  GOSUB 2000; * DISPLAY RECORD
 END
REPEAT
CRT @(0,22):CL:"Enter WO # to modify, A(add), B(back), P(page), '/'(esc), 'C'(comments)":
INPUT ANS
BEGIN CASE
 CASE ANS='/' OR ANS='?'
  * ESCAPE *
  STOP
 CASE ANS='C' OR ANS='c'
  IF MODE THEN
   GOSUB 80
   MODE=0
   B=0; LNCT=0
   GO 100
  END ELSE
   GOSUB 132
   MODE=1
   B=0; LNCT=0
   GO 100
  END
 CASE ANS='A' OR ANS='a'
  *ADD ITEM*
  OREC=''
  GOSUB 3000
 CASE ANS='B' OR ANS='b'
  *BACK PAGE*
 CASE ANS='P' OR ANS='p'
  *NEXT PAGE*
 CASE ANS >=1 AND ANS <= BCT 
  KEY=BRAY<1,ANS>
  GOSUB 4000 ;* DISPLAY DATA
  GOSUB 5000 ;* UPDATE INFO
 CASE 1
END CASE
CRT CS
LNCT=0
GO 100
*
2000 * DISPLAY DATA
 FOR A=1 TO 7
  IF A=1 THEN
   ISTR=B'L#2':IREC<A>'R#8' 
  END ELSE
   ISTR=IREC<A>
  END
  IF LAYOUT<5,A>#'' THEN
   ISTR=OCONV(ISTR,LAYOUT<5,A>)
  END
  ILEN=LAYOUT<4,A>
  IF A=7 THEN
   MCT=DCOUNT(ISTR,VM)
   IF MCT>1 THEN
    GOSUB 2600
    LN=LN:OSTR
   END ELSE
    GOSUB 2700
    LN=LN:OSTR
   END
  END ELSE
   GOSUB 2500
   LN=LN:OSTR
  END
 NEXT A
 GOSUB 2100
RETURN
*
2100 * PRINT LINE LOGIC
 IF LNCT=0 THEN
  IF MODE THEN
   GOSUB 132
   LN=FF:HD
  END ELSE
   LN=FF:HD[1,80]
  END
 END ELSE
  IF MODE ELSE
   LN=LN[1,75]
  END
 END
 IF LNCT > MAX THEN
  LNHOLD=LN
  LNCT=0
  GOSUB 2100
  LN=LNHOLD
 END
 PRINT LN
 LN=''
 LNCT=LNCT+1
RETURN
*
2500 * CONSTRUCT ELEMENTS FOR OUTPUT LINE
 OLEN=INT(ILEN/2)-INT(LEN(ISTR)/2)
 OSTR=SPACE(OLEN):ISTR
 MASK="L#":ILEN
 OSTR=OSTR MASK
RETURN
*
2600 * 
 FOR M=1 TO MCT
  IF M > 1 THEN
   OSTR=OSTR:LF:SPACE(75):ISTR<1,M>
  END ELSE
   OSTR=ISTR<1,M>
  END
 NEXT M
RETURN
*
2700 *
 MASK="L#":ILEN
 OSTR=ISTR MASK
RETURN
*
80 *
 A=CHAR(27):"`:":CHAR(12)
 PRINT A
RETURN
132 *
 A=CHAR(27):"`;":CHAR(12)
 PRINT A
RETURN
500 * DRAW A BOX CENTER SCREEN
 IF MODE THEN
  FCOL=39; FPOS=2; BCOL=93; BPOS=11
 END ELSE
  FCOL=15; FPOS=2; BCOL=69; BPOS=11
 END
550 *
 FOR W=FPOS TO BPOS
  IF W=FPOS OR W=BPOS THEN
   STRNG=RV:STR(" ",BCOL-FCOL):ERV
  END ELSE
   STRNG=RV:" ":ERV:STR(" ",BCOL-FCOL-2):RV:" ":ERV
  END
  CRT @(FCOL,W):STRNG
 NEXT W
RETURN
*
3000 * ADD LOGIC 
 GOSUB 500
 ACT=DCOUNT(LAYOUT<1>,VM)
 FOR A=1 TO ACT
  ALEN=LEN(LAYOUT<2,A>)
  XLEN=14
  CRT @(0,22):CL:LAYOUT<3,A>:
  IF A # 7 THEN
   CRT @(FCOL+2,FPOS+A):A:" ":LAYOUT<2,A>:STR(" ",XLEN-ALEN):": ":
   INPUT ANS
   IF A=1 THEN
    LOCATE(ANS,BRAY,1;NDX) THEN
     CRT @(0,22):BEEP:CL:"EXISTS ON FILE - TRY AGAIN!":
     RQM
     GO 3000
    END
   END
   IF LAYOUT<5,A>='D2/' THEN
    ANS=ICONV(ANS,'D2/')
    CRT @(FCOL+2,FPOS+A):A:" ":LAYOUT<2,A>:STR(" ",XLEN-ALEN):": ":OCONV(ANS,'D2/')
   END
  END ELSE
   HLD.ANS=''
   V=0
   CRT @(FCOL+2,FPOS+A):A:SPACE(12):RV:LAYOUT<2,A>:":":ERV
   LOOP
    V=V+1
    IF MODE THEN
     STRNG=RV:" ":ERV:STR(" ",BCOL-FCOL-2):RV:" ":ERV
     CRT @(FCOL,FPOS+A+V):STRNG
     FCOL=39; BCOL=93; BPOS=10+V; FPOS=BPOS
     GOSUB 550
     FPOS=2; BPOS=11
    END ELSE
     STRNG=RV:" ":ERV:STR(" ",BCOL-FCOL-2):RV:" ":ERV
     CRT @(FCOL,FPOS+A+V):STRNG
     FCOL=15; BCOL=69; BPOS=10+V; FPOS=BPOS
     GOSUB 550
     FPOS=2; BPOS=11
    END
    CRT @(FCOL+2,FPOS+A+V):
    INPUT ANS,50
    IF ANS # '' THEN
     HLD.ANS<1,V>=ANS
    END
   UNTIL ANS='' OR V >= 11 DO
    ANS=''
   REPEAT
  ANS=HLD.ANS
  END
  IF ANS # '' THEN
   OREC<A>=ANS
  END
 NEXT A
 GOSUB 9000 ;* PROMPT FOR 'E' OR '/'
RETURN
*
4000 * DISPLAY EXISTING DATA
 READ IREC FROM OFILE,KEY ELSE OREC=''
  IREC=INSERT(IREC,1;KEY)
  OREC=IREC
 GOSUB 500
 ACT=DCOUNT(LAYOUT<1>,VM)
 FOR A=1 TO ACT
  ALEN=LEN(LAYOUT<2,A>)
  XLEN=14
  IF A # 7 THEN
   IF LAYOUT<5,A>='D2/' THEN
    CRT @(FCOL+2,FPOS+A):A:" ":LAYOUT<2,A>:STR(" ",XLEN-ALEN):": ":OCONV(OREC<A>,'D2/')
   END ELSE
    CRT @(FCOL+2,FPOS+A):A:" ":LAYOUT<2,A>:STR(" ",XLEN-ALEN):": ":OREC<A>[1,LAYOUT<4,A>]
   END
  END ELSE
   HLD.ANS=''
   V=0
   CRT @(FCOL+2,FPOS+A):A:SPACE(12):RV:LAYOUT<2,A>:":":ERV
   LOOP
    V=V+1
    IF MODE THEN
     STRNG=RV:" ":ERV:STR(" ",BCOL-FCOL-2):RV:" ":ERV
     CRT @(FCOL,FPOS+A+V):STRNG
     FCOL=39; BCOL=93; BPOS=10+V; FPOS=BPOS
     GOSUB 550
     FPOS=2; BPOS=11
    END ELSE
     STRNG=RV:" ":ERV:STR(" ",BCOL-FCOL-2):RV:" ":ERV
     CRT @(FCOL,FPOS+A+V):STRNG
     FCOL=15; BCOL=69; BPOS=10+V; FPOS=BPOS
     GOSUB 550
     FPOS=2; BPOS=11
    END
    CRT @(FCOL+2,FPOS+A+V):OREC<7,V>
   UNTIL OREC<7,V>='' OR V >= 11 DO
   REPEAT
  END
 NEXT A
CRT @(0,22):CL:
RETURN
*
5000 * UPDATE LOGIC 
CRT @(0,22):CL:"YOU ARE HERE - AND YOU HAVE NO ONE TO BLAME BUT YOURSELF!":
INPUT ANY
 ACT=DCOUNT(LAYOUT<1>,VM)
 FOR A=1 TO ACT
  ALEN=LEN(LAYOUT<2,A>)
  XLEN=14
  CRT @(0,22):CL:LAYOUT<3,A>:
  IF A # 7 THEN
   CRT @(FCOL+2,FPOS+A):A:" ":LAYOUT<2,A>:STR(" ",XLEN-ALEN):": ":
   INPUT ANS
   IF ANS='/' THEN GO 5999
   IF ANS='*' THEN
    MASK="L#":LAYOUT<4,A>
    CRT @(FCOL+2,FPOS+A):A:" ":LAYOUT<2,A>:STR(" ",XLEN-ALEN):": ":'' MASK
   END ELSE
    IF A=1 AND ANS='D' THEN ;* DELETE RECORD
     CRT @(0,22):CL:BEEP:"Are you sure you want to DELETE this Work Order? ":
     INPUT ANY
     IF ANY='Y' OR ANY='y' THEN
      OREC<2>='DELETE'
      GO 5999
     END 
    END ELSE
     IF LAYOUT<5,A>='D2/' THEN
      ANS=ICONV(ANS,'D')
      CRT @(FCOL+2,FPOS+A):A:" ":LAYOUT<2,A>:STR(" ",XLEN-ALEN):": ":OCONV(ANS,'D2/')
     END
    END
   END
  END ELSE
   HLD.ANS=''
   V=0
   CRT @(FCOL+2,FPOS+A):A:SPACE(12):RV:LAYOUT<2,A>:":":ERV
   LOOP
    V=V+1
    IF MODE THEN
     STRNG=RV:" ":ERV:STR(" ",BCOL-FCOL-2):RV:" ":ERV
     CRT @(FCOL,FPOS+A+V):STRNG
     FCOL=39; BCOL=93; BPOS=10+V; FPOS=BPOS
     GOSUB 550
     FPOS=2; BPOS=11
    END ELSE
     STRNG=RV:" ":ERV:STR(" ",BCOL-FCOL-2):RV:" ":ERV
     CRT @(FCOL,FPOS+A+V):STRNG
     FCOL=15; BCOL=69; BPOS=10+V; FPOS=BPOS
     GOSUB 550
     FPOS=2; BPOS=11
    END
    CRT @(FCOL+2,FPOS+A+V):
    INPUT ANS,50
    IF ANS # '' THEN
     HLD.ANS<1,V>=ANS
    END
   UNTIL ANS='' OR V >= 11 DO
    ANS=''
   REPEAT
  ANS=HLD.ANS
  END
  IF ANS # '' THEN
   IF ANS='*' THEN
    OREC<A>=""
   END ELSE
    OREC<A>=ANS
   END
  END
  NEXT A
5999 *
 GOSUB 9000 ;* PROMPT FOR 'E' OR '/'
RETURN
*
9000 * WRITE RECORD
IF OREC<2>='DELETE' THEN
 KEY=OREC<1>
 DELETE OFILE,KEY
 LOCATE(KEY,BRAY,1;NDX) THEN
  BRAY=DELETE(BRAY,1,NDX)
 END
END ELSE
 CRT @(0,22):CL:"Enter 'E'(end) or '/'(escape) :":
 INPUT ANS
 BEGIN CASE 
 CASE ANS='E' 
  KEY=OREC<1>
  LOCATE(KEY,BRAY,1;NDX) ELSE
   BRAY=INSERT(BRAY,1,NDX;KEY)
  END
  OREC=DELETE(OREC,1)
  WRITE OREC ON OFILE,KEY
 CASE ANS='/'
  OREC=''
 CASE 1
  CRT @(0,22):BEEP:CL:"INVALID RESPONSE - TRY AGAIN!":
  RQM
  GO 9000
 END CASE
END
RETURN
*
10000 * SETUP LAYOUT ARRAY
FOR A=1 TO 7
 LAYOUT<1,A>=A
NEXT A
LAYOUT<2,1>='WORK ORDER'
LAYOUT<3,1>='Enter the WORK ORDER #'
LAYOUT<4,1>=10
*
LAYOUT<2,2>='WO DATE'
LAYOUT<3,2>='Enter the DATE the Work Order was Submitted'
LAYOUT<4,2>=10
LAYOUT<5,2>='D2/'
*
LAYOUT<2,3>='DUE DATE'
LAYOUT<3,3>='Enter the DATE the Work Order is DUE'
LAYOUT<4,3>=10
LAYOUT<5,3>='D2/'
*
LAYOUT<2,4>='DESCRIPTION'
LAYOUT<3,4>='Enter a brief DESCRIPTION of this Work Order'
LAYOUT<4,4>=30
*
LAYOUT<2,5>='PRGMR'
LAYOUT<3,5>='Enter PROGRAMMER assigned to the task'
LAYOUT<4,5>=5
*
LAYOUT<2,6>='COMPLETED'
LAYOUT<3,6>='Enter the DATE this project was COMPLETED'
LAYOUT<4,6>=10
LAYOUT<5,6>='D2/'
*
LAYOUT<2,7>='POST COMPLETION NOTES'
LAYOUT<3,7>='Enter NOTES (ie, counts, outstanding issues, etc.)'
LAYOUT<4,7>=50
*
 ACT=DCOUNT(LAYOUT<1>,VM)
 FOR A=1 TO ACT
  ISTR=LAYOUT<2,A>
  ILEN=LAYOUT<4,A>
  GOSUB 2500
  HD=HD:OSTR
 NEXT A
*
RETURN