* Program: BBB550
* Manual Invoice Entry
* Copyright ALP Systems LLC
*
PROMPT ''
PROGRAM='BBB550'
COID = "03"
*****************
* Set variables *
*****************
CLR=@(-1) ; EOP=@(-3) ; EOL=@(-4) ; BON=@(-7) ; BOF=@(-8)
PR=@(0,22):EOL ; ER=@(0,23):EOL ; BELL=CHAR(7) ; EBELL=ER:BELL
TODAY = DATE()
REQD = EBELL:'Required Field '; INVLD = EBELL:'Invalid Entry -> '
ST.ROW = 5 ; NBR.ROWS = 16
ZZ1=CHAR(27):'H:' ; ZZ5=CHAR(27):'H,'
VM=CHAR(253) ; AM=CHAR(254) ; SVM=CHAR(252)
CS=@(-1) ; CEOL=@(-4) ; CEOS=@(-3) ; PMPT=@(0,22):CEOL
CERR=@(0,23):CEOL ; ERR=CERR:BELL
T = 1 ; F = 0 ; OTHERWISE = 1 ; BADS='' ; DISPLAY=1 ; REDO=0
FOR M=0 TO 31
BADS:=CHAR(M)
NEXT M
*
SCUST.FILE = 'SCUST*':COID
ARI.FILE = 'ARI*':COID
TICKET.FILE = 'TICKET*':COID
JOB.FILE = 'JOB*':COID
OARI.FILE = 'OARI*':COID
X = 0 ; CANT = 'Cant open file '
OPEN 'CUST' TO F.CUST ELSE CRT CANT:'CUST'; X = 1
OPEN SCUST.FILE TO F.SCUST ELSE CRT CANT:SCUST.FILE; X = 1
OPEN ARI.FILE TO ARI ELSE CRT CANT:ARI.FILE; X = 1
OPEN OARI.FILE TO OARI ELSE CRT CANT:OARI.FILE; X = 1
OPEN JOB.FILE TO F.JOB ELSE CRT CANT:JOB.FILE; X = 1
OPEN TICKET.FILE TO TICKET ELSE CRT CANT:TICKET.FILE; X = 1
OPEN 'CTRL' TO CTRL ELSE CRT CANT:'CTRL'; X = 1
OPEN 'ACTIONS,BBB550' TO ACTIONS ELSE CRT CANT:'ACTIONS' ; X=1
IF X THEN CRT 'ABORT! Press (RETURN) ':; INPUT Q:; GO 9999
*********
* Forms *
*********
FORMS = CLR:'(:PROGRAM:') Company: ':COID:' Manual Invoice Entry'
FORMS = FORMS:@(59,0):TIMEDATE()
FORMS = FORMS:@(0,1):STR(ZZ5,80)
FORMS = FORMS:@(0,6):STR(ZZ5,80)
FORM1 = @(0,9):EOP:' Inv Nbr Inv Date Age':SPACE(7):'Total Discount Balance Due Job'
FORM1:= @(0,10):STR(ZZ5,80)
FORM3 = @(0,10):EOP:STR(ZZ1,80):@(0,11):CEOS:'Line':@(6):'Job#':@(11):'Description':@(55):'Beg Date':@(65):'Original Amt'
FORM5 = @(0,10):EOP:STR(ZZ1,80):@(0,11):CEOS:'Line':@(6):'Invoice':@(15):'Job Number':@(55):'Inv Date':@(65):' Amount'
IN.DESC=46 ; IN.QTY=45 ; IN.PRICE=47 ; IN.EXT=55 ; IN.UOM=54
90 CRT FORMS:
*******************
* Customer Number *
*******************
100 CRT PR:'Customer Number/Name ; (enter) to exit program ':
INPUT CUSTID
BEGIN CASE
CASE CUSTID = '' ; GO 9999
CASE NUM(CUSTID) ; GO 200
CASE 1
XCUSTID = CUSTID
FOUND=0; CALL BBS000(XCUSTID,CUSTID,FOUND)
BEGIN CASE
CASE CUSTID = '' ; GO 90
CASE CUSTID = 'X' ; GO 9999
CASE NUM(CUSTID)
IF FOUND > 1 THEN CRT FORMS:
CASE 1
CRT EBELL:CUSTID:' not on cross-reference.':; GO 100
END CASE
END CASE
****************
* Read file(s) *
****************
200 READ R.CUST FROM F.CUST, CUSTID ELSE
CRT EBELL:'"':CUSTID:'" IS NOT ON FILE ! ':; GO 100
END
READ DOARI FROM OARI, CUSTID ELSE DOARI=''
JOBID=''
*
INFO = @(0,2):CUSTID
INFO = INFO:@(6,2):R.CUST<1>[1,35]
INFO = INFO:@(6,3):R.CUST<2>[1,35]
IF R.CUST<3> = '' THEN
INFO = INFO:@(6,4):R.CUST<4>:' ':R.CUST<5>:' ':R.CUST<6>
END ELSE
INFO = INFO:@(6,4):R.CUST<3>[1,40]
INFO = INFO:@(6,5):R.CUST<4>:' ':R.CUST<5>:' ':R.CUST<6>
END
CRT INFO:
***************
* User Choice *
***************
500 RELEASE
VALIDACTS='E':AM:'N':AM:'D':AM:'J':AM:'I':AM:'Q'
PARAMETER='' ; RESP=''
PARAMETER<1>=9 ; * Spacing of action words
PARAMETER<2>=22 ; * y coordinate
CALL USER.ACTION(ACTIONS,VALIDACTS,RESP,PROGRAM,PARAMETER)
BEGIN CASE
CASE RESP = 'I' ; GO 600 ; * display unpaid invoices
CASE RESP = 'J' ; GO 5000 ; * display jobs for customer
CASE RESP = 'Q' ; GO 9999 ; * exit program
CASE RESP = 'E' ; GO 90 ; * exit customer
CASE RESP = 'N' ; GO 1000 ; * enter new invoice
CASE RESP = 'D' ; GO 4000 ; * display/modify unposted invoice
CASE 1 ; GO 500
END CASE
**************************
* Invoice display screen *
**************************
600 NBR.INVS = DCOUNT(DOARI,AM)
AA = NBR.INVS/10 ; BB = INT(AA)
PAGE.NBR = 1 ; TOT.BAL.DUE=0
IF AA = BB THEN NBR.PAGES = BB ELSE NBR.PAGES = BB + 1
*
620 IF NBR.INVS > 0 THEN
FIRST.INV = 1 ; LINE.CTR = 11
FOR C = 1 TO NBR.INVS
IF FIRST.INV OR LINE.CTR = 21 THEN
IF NOT(FIRST.INV) THEN
CRT PR:'(enter) to continue ; eit ':
INPUT RESP: ; RESP = OCONV(RESP,'MCU')
IF RESP = 'X' THEN GO 680
END
CRT FORM1:
CRT @(65,6):'Page ':PAGE.NBR:' of ':NBR.PAGES
FIRST.INV = 0 ; LINE.CTR = 11 ; PAGE.NBR += 1
END
ON.INV=1; K.INVOICE=DOARI
PRT.LN = C 'R#3':K.INVOICE 'R#7':SPACE(4)
READ DARI FROM ARI, CUSTID:'*':K.INVOICE ELSE ON.INV=0
IF NOT(ON.INV) THEN
ON.INV=1
READ DARI FROM OTHER.ARI, CUSTID:'*':K.INVOICE ELSE ON.INV=0
END
IF ON.INV THEN
PRT.LN = PRT.LN:OCONV(DARI<1>,'D2-') 'R#10'
INV.AGE = TODAY - DARI<1>
PRT.LN = PRT.LN:INV.AGE 'R#5'
PRT.LN = PRT.LN:OCONV(DARI<2>,'MR2,') 'R#12'
BAL.DUE=DARI<9> ; TOT.BAL.DUE+=BAL.DUE
IF BAL.DUE # 0 THEN
PRT.LN = PRT.LN:OCONV(DARI<4>,'MR2,') 'R#10'
END ELSE
PRT.LN = PRT.LN:SPACE(10)
END
PRT.LN = PRT.LN:OCONV(BAL.DUE,'MR2,') 'R#15'
PRT.LN = PRT.LN:SPACE(8)
PRT.LN = PRT.LN:' ':DARI<6>[1,4]'R#4'
END ELSE PRT.LN = PRT.LN:' Not on file!'
CRT @(0,LINE.CTR):PRT.LN: ; LINE.CTR += 1
NEXT C
END ELSE
CRT PR:'There are no open invoices on this account.':
END
CRT ER:'End of Invoices. (enter) ':
INPUT RESP: ; RESP = TRIM(RESP)
680 CRT @(0,6):STR(ZZ5,80):@(0,9):EOP:
GO 500
*********************
* New Invoice Entry *
*********************
1000 TICKETID='NEW' ; DTICKET=''
CRT @(50,4):EOL:@(50):'Ticket Number: ':TICKETID:
MODIFY.FLAG=0
GOSUB 6000
GO 500
************************************
* Display/Modify Unposted Invoices *
************************************
4000 TICKETID=''
SEN = 'SSELECT TICKET*':COID:' WITH 82 = "" AND WITH 2 = "':CUSTID:'" BY-DSND 0'
EXECUTE 'P'
EXECUTE SEN RETURNING ERRMSG
EXECUTE 'P'
IF ERRMSG=401 THEN
CRT ER:'No unposted invoices for this Customer. (enter) ':
INPUT QAZ: ; GO 500
END
*+
FINI=0
TLIST = ''
LOOP
READNEXT K.TICKET ELSE FINI=1
UNTIL FINI DO
TLIST<-1> = K.TICKET
REPEAT
*+
NBRTICKETS = DCOUNT(TLIST,AM)
FIRSTTICKET = 1
CRT FORM5
FOUNDTICKET = F
LOOP
LASTTICKET = FIRSTTICKET + 8
IF LASTTICKET > NBRTICKETS THEN LASTTICKET = NBRTICKETS
CRT @(0,12):CEOS
LN = 11
FOR TTT = FIRSTTICKET TO LASTTICKET
LN = LN + 1
K.TICKET = TLIST
READ R.TICKET FROM TICKET, K.TICKET ELSE R.TICKET = ''
TICKETLN = TTT:@(6):K.TICKET:@(15):R.TICKET<48>[1,40]:@(55):OCONV(R.TICKET<28>,'D2/'):@(65):OCONV(R.TICKET<81>,'MD2,')"R#12"
CRT @(0,LN):TICKETLN
NEXT TTT
GI=F ; ERR.F=F ; CANCEL.F=F
LOOP UNTIL GI OR CANCEL.F DO
CRT PR:"Enter Line Number; (F)orward; (B)ackward; (Q)uit ":
INPUT REPLY
BEGIN CASE
CASE REPLY = 'Q'
CANCEL.F = T
CASE REPLY = 'F'
IF LASTTICKET = NBRTICKETS THEN
CRT ER:'Cannot move Forward':
ERR.F = T
END ELSE
FIRSTTICKET = FIRSTTICKET + 9
GI = T
END
CASE REPLY = 'B'
IF FIRSTTICKET = 1 THEN
CRT ER:'Cannot move Backward':
ERR.F = T
END ELSE
FIRSTTICKET = FIRSTTICKET - 9
GI = 1
END
CASE NUM(REPLY)
IF REPLY GE FIRSTTICKET AND REPLY LE LASTTICKET THEN
GI = T
TICKETID = TLIST
FOUNDTICKET = T
END ELSE
CRT ER:'Line number is not on this page':
ERR.F = T
END
CASE OTHERWISE
ERR.F = T
CRT ER:'Invalid Entry -> ':REPLY:
END CASE
REPEAT
UNTIL FOUNDTICKET OR CANCEL.F DO REPEAT
IF TICKETID#'' THEN
LOC=0
READU DTICKET FROM TICKET, TICKETID LOCKED LOC=1 ELSE DTICKET=''
IF LOC THEN
CRT ER:'Ticket locked by another user. (enter) ':
INPUT QAZ: ; GO 500
END
CRT @(50,4):EOL:@(50):'Ticket Number: ':TICKETID:
GOSUB 7000
MODIFY.FLAG=0
IF JOBID#'' THEN DTICKET<48>=JOBID ELSE JOBID=DTICKET<48>
REDO=1 ; GOSUB 5200 ; REDO=0 ; * Job Number
GOSUB 6000
END
GO 500
**********************
* Job display screen *
**********************
5000 JOBID=''
SEN = 'SSELECT JOB*':COID:' WITH 1 = "':CUSTID:'" BY-DSND 3 BY-DSND 0'
EXECUTE 'P'
EXECUTE SEN RETURNING ERRMSG
EXECUTE 'P'
IF ERRMSG=401 THEN
CRT ER:'No Jobs for this Customer. (enter) ':
INPUT QAZ: ; GO 500
END
*+
FINI=0
JOBLIST = ''
LOOP
READNEXT K.JOB ELSE FINI=1
UNTIL FINI DO
JOBLIST<-1> = K.JOB
REPEAT
*+
NBRJOBS = DCOUNT(JOBLIST,AM)
FIRSTJOB = 1
CRT FORM3
FOUNDJOB = F
LOOP
LASTJOB = FIRSTJOB + 8
IF LASTJOB > NBRJOBS THEN LASTJOB = NBRJOBS
CRT @(0,12):CEOS
LN = 11
FOR JOB = FIRSTJOB TO LASTJOB
LN = LN + 1
K.JOB = JOBLIST
READ R.JOB FROM F.JOB,K.JOB THEN
READV NAME FROM F.CUST,R.JOB<1>,1 ELSE NAME = '***Not On File'
END ELSE
R.JOB = ''
NAME = '***Not On File'
END
JOBLN = JOB:@(6):K.JOB:@(15):R.JOB<2>[1,35]:@(55):OCONV(R.JOB<3>,'D2/'):@(65):OCONV(R.JOB<4>,'MD2,')"R#12"
CRT @(0,LN):JOBLN
NEXT JOB
GI=F ; ERR.F=F ; CANCEL.F=F
LOOP UNTIL GI OR CANCEL.F DO
CRT PR:'Enter Line Number; (F)orward; (B)ackward; (Q)uit ':
INPUT REPLY
BEGIN CASE
CASE REPLY = 'Q'
CANCEL.F = T
CASE REPLY = 'F'
IF LASTJOB = NBRJOBS THEN
CRT ER:'Cannot move Forward':
ERR.F = T
END ELSE
FIRSTJOB = FIRSTJOB + 9
GI = T
END
CASE REPLY = 'B'
IF FIRSTJOB = 1 THEN
CRT ER:'Cannot move Backward':
ERR.F = T
END ELSE
FIRSTJOB = FIRSTJOB - 9
GI = 1
END
CASE NUM(REPLY)
IF REPLY >= FIRSTJOB AND REPLY <= LASTJOB THEN
GI = T
JOBID = JOBLIST
FOUNDJOB = T
END ELSE
CRT ER:'Line number is not on this page':
ERR.F = T
END
CASE OTHERWISE
ERR.F = T
CRT ER:'Invalid Entry -> ':REPLY:
END CASE
REPEAT
UNTIL FOUNDJOB OR CANCEL.F DO REPEAT
5200 CRT @(50,2):EOL:@(50):'Job Number: ':JOBID:@(0,10):EOP:
IF REDO THEN RETURN
GO 500
*****************
* Entry Routine *
*****************
6000 SCR4=@(0,9):EOP:@(0,9):STR(ZZ5,80):@(0,10):BON
SCR4:=' ## Description':@(43):'Quantity UOM'
SCR4:=@(64):'Price':@(71):'Extension':BOF
MODS=0
CRT SCR4:
MNE=DCOUNT(DTICKET,VM)
IF DTICKET='' THEN ADDING=1 ELSE ADDING=0
BE=1 ; EE=10
IF ADDING THEN
EN=1 ; GO 6100
END
*+
6050 GOSUB 6400
*+
6060 VALIDACTS='A':AM:'U':AM:'X'
IF DTICKET#'' THEN VALIDACTS:=AM:'M':AM:'T'
IF MNE GE 10 THEN VALIDACTS:=AM:'P'
IF DTICKET<48>#'' THEN VALIDACTS:=AM:'R'
PARAMETER=''
PARAMETER<1>=8 ; * Spacing of action words
PARAMETER<2>=22 ; * y coordinate
CALL USER.ACTION(ACTIONS,VALIDACTS,ANS2,PROGRAM,PARAMETER)
BEGIN CASE
CASE ANS2='R' AND DTICKET<48>#''
DTICKET<48>=''
JOBID=DTICKET<48> ; REDO=1 ; GOSUB 5200 ; REDO=0 ; * Job Number
CASE ANS2='X' ; * eXit
IF MODS THEN
DMY=''
LOOP
UNTIL DMY='YES' OR DMY='NO' DO
CRT PR:'Modifications made. Do you want to exit without updating? ':
INPUT DMY: ; DMY=OCONV(DMY,'MCU')
REPEAT
IF DMY='NO' THEN GO 6060
END
****************
* Reset Screen *
****************
6070 FOR M=2 TO 5
CRT @(50,M):EOL:
NEXT M
CRT @(0,7):EOP:
RETURN
CASE ANS2='U' ; * Update
************************
* Assign Ticket Number *
************************
IF TICKETID='NEW' THEN
DTICKET<2>=CUSTID
DTICKET<25>=1 ; * status
CTRLID='NEXT.TICKET*':COID
READVU NEXT.NBR FROM CTRL, CTRLID, 1 ELSE
CRT PR:CHAR(7):'FATAL! UNABLE TO READ NEXT TICKET NUMBER. (enter) ':
INPUT RESP: ; GO 9999
END
TICKETID = NEXT.NBR
DTICKET<37>=TICKETID
NEXT.NBR +=1
WRITEV NEXT.NBR ON CTRL, CTRLID, 1
*+
READU BASELOC FROM CTRL, 'BASE.LOCATIONS' ELSE GO 6080
LOCATE COID IN BASELOC<3>, 1 SETTING LLL ELSE GO 6080
IACN = BASELOC<2,LLL>:BASELOC<4,LLL>
BASELOC<4,LLL>+=1
WRITE BASELOC ON CTRL, 'BASE.LOCATIONS'
DTICKET<58>=IACN
6080 END
*+
*+ enter invoice date
DTICKET<1>=DATE() ; DTICKET<28>=DATE()
*+ enter invoice type (default=1)
* DTICKET=1
*+
DTICKET<48>=JOBID ; * associated job number
DISPLAY=0 ; GOSUB 7000 ; DISPLAY=1
DTICKET<81>=INVTOTAL ; * invoice total
WRITE DTICKET ON TICKET, TICKETID
*+
CRT PR:'Ticket ':TICKETID:' updated. Remember to Print and Post. (enter) ':
INPUT QAZ:
GO 6070 ; * reset screen
CASE ANS2='T' AND DTICKET#''
CRT PR:'Enter Line Number to Insert BEFORE ':
INPUT LINENO:
IF NUM(LINENO)=0 THEN LINENO=0
LINENO=INT(LINENO)
IF LINENO<1 OR LINENO>MNE THEN
CRT ER:'Invalid Line Number.': ; GO 6060
END
DTICKET=INSERT(DTICKET,IN.DESC,LINENO,0,'*')
DTICKET=INSERT(DTICKET,IN.QTY,LINENO,0,'0')
DTICKET=INSERT(DTICKET,IN.PRICE,LINENO,0,'0')
DTICKET=INSERT(DTICKET,IN.EXT,LINENO,0,'0')
DTICKET=INSERT(DTICKET,IN.UOM,LINENO,0,'*')
DATA LINENO
GO 6000
CASE ANS2='A'
EN=MNE+1
IF EN GE BE AND EN LE EE THEN GO 6100
BE=(INT((EN-1)/10)*10)+1 ; EE=BE+9 ; GOSUB 6400 ; GO 6100
CASE ANS2='P'
IF MNE L 11 THEN BE=1 ; EE=10 ; GO 6050
IF MNE GE EE+1 THEN BE=BE+10 ; EE=EE+10 ELSE BE=1 ; EE=10
CASE ANS2='M' ; * modify
LOOP
UNTIL NUM(ANS2)=1 DO
CRT PR:'Enter Line Number (##) to modify ':
INPUT ANS2:
REPEAT
IF NOT(ANS2 GT 0 AND ANS2 LE MNE) THEN CRT ER:"Not valid, must be between 1 and ":MNE:BELL: ; GO 6060
IF NOT(ANS2 GE BE AND ANS2 LE EE) THEN CRT ER:"Not on this page.":BELL: ; GO 6060
EN=ANS2
MODIFY.FLAG=1 ; CRT PR:
GO 6100
END CASE
GO 6050
****************
* GET AN ENTRY *
****************
6100 R=(EN-BE+11) ; CRT @(1,R):BOF:EN'R%2':BOF:
IF DTICKET='' THEN ADDING=1 ELSE ADDING=0
X1=DTICKET ; X2=DTICKET
X3=DTICKET ; X4=DTICKET ; X5=DTICKET
***************
* Description *
***************
6120 XXX=X1 ; MSK='L#41' ; DL=40 ; C=4 ; MAX=0 ; CV=''
INSTRUCT=BON:'<':BOF:'Enter':BON:'> key to exit entry '
IF XXX#'' THEN INSTRUCT:='; <':BOF:'TAB':BON:'> key to Delete Line'
INSTRUCT:=BOF
INSTRUCT1=BON:'<':BOF:'##':BON:'>=description ':BOF
INSTRUCT1:=BON:'<':BOF:'#E':BON:'>=extension ':BOF
INSTRUCT1:=BON:'<':BOF:'#S':BON:'>=subtotal ':BOF
INSTRUCT1:=BON:'<':BOF:'#T':BON:'>=total ':BOF
INSTRUCT1:=BON:'<':BOF:'#X':BON:'>=exclude from total':BOF
CRT @(0,7):EOL:INSTRUCT:
CRT @(0,8):EOL:INSTRUCT1:
IF XXX='' THEN CRT @(C,R):STR("_",DL):@(C,R): ELSE CRT @(C,R):
RESP=''
LOOP
INPUT Q,0: ; S=SEQ(Q)
UNTIL S=10 OR S=13 OR S=255 OR LEN(RESP)=DL DO
BEGIN CASE
CASE S=9 AND MODIFY.FLAG ; * tab (delete line)
IF RESP='' AND DTICKET#'' THEN
DEL DTICKET ; DEL DTICKET
DEL DTICKET; DEL DTICKET; DEL DTICKET
END
GOSUB 7000 ; * display invoice total
CRT @(0,7):EOL:@(0,8):EOL:
GO 6050
CASE S=8 ; * backspace
IF LEN(RESP)>1 THEN RESP=RESP[1,LEN(RESP)-1] ELSE RESP=''
CRT @(C,R):STR("_",DL):@(C,R):RESP:
CASE S LE 31 ; * special characters (ignore)
CASE 1
RESP:=Q
END CASE
CRT @(C,R):STR("_",DL):@(C,R):RESP:
REPEAT
IF RESP='' AND MODIFY.FLAG THEN RESP=X1
RESP=RESP[1,DL]
***
6135 CRT @(0,7):EOL:@(0,8):EOL:
CRT @(C,R):RESP MSK:
****
IF RESP='' AND ADDING THEN CRT @(0,R):EOL: ; GOSUB 6440 ; GO 6060
X1=RESP ; CRT @(C,R):RESP MSK:
************
* Quantity *
************
6140 XXX=X2 ; MSK='R#8' ; DL=8 ; C=43 ; MAX=0 ; CV='MR2' ; VALIDS=''
GOSUB 7500
X2=RESP
*******
* UOM *
*******
6150 XXX=X5 ; MSK='L#4' ; DL=4 ; C=53 ; MAX=0 ; CV='' ; VALIDS=''
GOSUB 7500
X5=RESP
*********
* Price *
*********
6160 XXX=X3 ; MSK='R#10' ; DL=9 ; C=59 ; MAX=0 ; CV='MR2' ; VALIDS=''
GOSUB 7500
X3=RESP
*************
* Extension *
*************
6220 XXX=X4 ; MSK='R#10' ; DL=10 ; C=70 ; MAX=0 ; CV='MR2'
RESP=X2 * X3 ; RESP=OCONV(RESP,'MR24') ; DATA RESP
GOSUB 7500
X4=RESP
IF MODIFY.FLAG THEN MODIFY.FLAG=0
*+
DTICKET=X1
DTICKET=X2
DTICKET=X3
DTICKET=X4
DTICKET=X5
GOSUB 7000 ; * display invoice total
IF ADDING THEN
CRT @(1,R):BON:EN'R%2':BOF:
EN=EN+1
IF EN > EE THEN
BE+=10 ; EE+=10 ; GOSUB 6400
END
GO 6100
END ELSE
GOSUB 6440
GO 6060
END
***********************
* Display 'up a page' *
***********************
6400 JJ=@(0,11):EOP
FOR XX = BE TO EE WHILE DTICKET#''
JJ:=@(1,11+XX-BE):BON:XX'R%2':BOF:' ':DTICKET'L#41'
JJ:=@(43):OCONV(DTICKET,'MR2,')'R#8'
JJ:=@(53):DTICKET'L#4'
JJ:=@(59):OCONV(DTICKET,'MR2,')'R#10'
JJ:=@(70):OCONV(DTICKET,'MR2,')'R#10'
NEXT XX
CRT JJ:
6440 MNE=DCOUNT(DTICKET,VM)
RETURN
*****************
* Invoice Total *
*****************
7000 INVTOTAL=0 ; MODS=1
X1=DTICKET ; X2=DTICKET
LOOP
UNTIL X1='' DO
TDESC=OCONV(X1<1,1>,'MCU') ; TAMT=X2<1,1>
X1=DELETE(X1,1,1,0) ; X2=DELETE(X2,1,1,0)
IF TDESC[1,2] # '#X' THEN INVTOTAL+=TAMT
REPEAT
IF DISPLAY THEN
CRT @(50,5):EOL:@(50):'Invoice Total: ':OCONV(INVTOTAL,'MR2,$'):
END
RETURN
********************
* Input Subroutine *
********************
7500 IF XXX='' THEN CRT @(C,R):STR("_",DL):@(C,R): ELSE CRT @(C,R):
INPUT RESP,DL
RESP=RESP[1,DL]
CONVERT BADS TO '' IN RESP
IF RESP='' AND XXX#'' THEN
IF CV#'' THEN XXX=OCONV(XXX,CV)
RESP=XXX
END
7520 RESP=TRIM(RESP)
BEGIN CASE
CASE RESP='' AND XXX=''
RESP='*'
IF CV[1,1]='M' THEN RESP=0
CASE CV#''
RESP=ICONV(RESP,CV)
IF CV[1,1]='M' AND NUM(RESP)=0 THEN
CRT ER:'Invalid Entry.':BELL: ; GO 7500
END
END CASE
BEGIN CASE
CASE CV#''
CRT @(C,R):SPACE(DL):@(C,R):OCONV(RESP,CV) MSK:
CASE 1
CRT @(C,R):SPACE(DL):@(C,R):RESP[1,DL] MSK:
END CASE
RETURN
******************
* End of program *
******************
9999 END