tldm-universe/CMS/BP.CLOCK/STATUS.WO
2024-09-10 15:25:06 -04:00

418 lines
8.0 KiB
Plaintext
Executable File

*--------------------------*
* 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