added LSL2 stored procedures
This commit is contained in:
116
LSL2/STPROC/SCHED_RPT1.txt
Normal file
116
LSL2/STPROC/SCHED_RPT1.txt
Normal file
@ -0,0 +1,116 @@
|
||||
compile function SCHED_RPT1()
|
||||
begin condition
|
||||
pre:
|
||||
post:
|
||||
end condition
|
||||
declare function msg, set_property, send_event, dialog_box, utility, get_property, PrintSetup, Set_Printer
|
||||
declare subroutine rlist, or_view, activate_save_select, yield
|
||||
$insert rlist_equates
|
||||
$insert msg_equates
|
||||
$INSERT PRINTSETUP_EQUATES
|
||||
|
||||
Params = dialog_box( 'SCHED_RPT1', @window, '*CENTER' )
|
||||
if Params = 'CANCEL' or Params = '' then
|
||||
return 0
|
||||
end
|
||||
open 'SYSLISTS' to SysListsTable else
|
||||
MsgInfo = ''
|
||||
MsgInfo<mcol$> = -2
|
||||
MsgInfo<mrow$> = -2
|
||||
MsgInfo<mtext$> = 'Unable to open SYSLISTS...'
|
||||
Void = msg( '', MsgInfo )
|
||||
return 0
|
||||
end
|
||||
ListsId = 'SCHED_RPT1*':@station
|
||||
write '' on SysListsTable, ListsId else
|
||||
MsgInfo = ''
|
||||
MsgInfo<mcol$> = -2
|
||||
MsgInfo<mrow$> = -2
|
||||
MsgInfo<mtext$> = 'Unable to clear SYSLISTS ':ListsId:'...'
|
||||
Void = msg( '', MsgInfo )
|
||||
return 0
|
||||
end
|
||||
convert '*' to @fm in Params
|
||||
BillFrom = Params<1>
|
||||
BillThru = Params<2>
|
||||
DirToPrinter = Params<3>
|
||||
Custs = Params<4>
|
||||
Plant = Params<5>
|
||||
begin case
|
||||
case Plant = 'All'
|
||||
PlantStmt = ''
|
||||
case Plant = 'Tempe'
|
||||
PlantStmt = ' AND WITH WO < 100000'
|
||||
case Plant = 'Mesa'
|
||||
PlantStmt = ' AND WITH WO > 100000'
|
||||
end case
|
||||
SchedTable = 'SCHEDULE'
|
||||
Stat = utility( 'CURSOR', 'H' )
|
||||
Stmt = 'SELECT ':SchedTable:' BY CUST_CITY'
|
||||
if BillFrom and BillThru then
|
||||
Stmt := " WITH SHIP_DATE FROM ":QUOTE(BillFrom):' TO ':QUOTE(BillThru)
|
||||
end else
|
||||
if BillFrom then
|
||||
Stmt := " WITH SHIP_DATE GE ":QUOTE(BillFrom)
|
||||
end
|
||||
if BillThru then
|
||||
Stmt := " WITH SHIP_DATE LE ":QUOTE(BillThru)
|
||||
end
|
||||
end
|
||||
Stmt := PlantStmt
|
||||
if Custs then
|
||||
swap @vm with "' '" in Custs
|
||||
Custs = "'":Custs:"'"
|
||||
Stmt := ' AND WITH CUST_NO = ':Custs
|
||||
end
|
||||
rlist( Stmt, target_savelist$, ListsId, '', '' )
|
||||
|
||||
activate_save_select( ListsId )
|
||||
if @reccount then
|
||||
Cmd = "LIST ":SchedTable:" BREAK-ON CUST_CITY ":QUOTE("'V'")
|
||||
Cmd:= " JUSTLEN 55 SHIP_DATE JUSTLEN 0 DET-SUPP LIMIT SHIP_DATE "
|
||||
Cmd:= " FROM ":QUOTE(BillFrom):" TO ":QUOTE(BillThru)
|
||||
Cmd:= " TOTAL SHIP_QTY JUSTLEN 6 COLHEAD 'Qty' TOTAL SHIP_AMOUNT JUSTLEN 16"
|
||||
Cmd:= " HEADING ":'"':" Billings by Company 'T' PAGE # 'PP''L' for Selected Dates From (":BillFrom:" ) Thru (":BillThru:")":'" '
|
||||
Cmd:= " ID-SUPP"
|
||||
if DirToPrinter = 'Yes' then
|
||||
rlist( Cmd, 0, '', '', '' )
|
||||
end else
|
||||
or_view( '', Cmd )
|
||||
Void = set_property( 'ORPRV.PRINT', 'ENABLED', 0 )
|
||||
WinId = 'ORPRV'
|
||||
loop
|
||||
while get_property( WinId, 'HANDLE' )
|
||||
yield()
|
||||
repeat
|
||||
ToPrint = ''
|
||||
MsgInfo = ''
|
||||
MsgInfo<mtext$> = 'Do you want to print this report?'
|
||||
MsgInfo<micon$> = '?'
|
||||
MsgInfo<mtype$> = 'BNY'
|
||||
MsgInfo<mcol$> = -2
|
||||
MsgInfo<mrow$> = -2
|
||||
MsgInfo<mdefbtn$> = 2 ;* default to no
|
||||
ToPrint = msg( @window, MsgInfo )
|
||||
if ToPrint then
|
||||
activate_save_select( ListsId )
|
||||
rlist( Cmd, 0, '', '', '' )
|
||||
end
|
||||
end
|
||||
end else
|
||||
MsgInfo = ''
|
||||
MsgInfo<mcol$> = -2
|
||||
MsgInfo<mrow$> = -2
|
||||
MsgInfo<mtext$> = 'NO Records meeting your date criteria!!'
|
||||
MsgInfo<micon$> = '!'
|
||||
Void = msg( '', MsgInfo )
|
||||
end
|
||||
write '' on SysListsTable, ListsId else
|
||||
MsgInfo = ''
|
||||
MsgInfo<mcol$> = -2
|
||||
MsgInfo<mrow$> = -2
|
||||
MsgInfo<mtext$> = 'Unable to clear SYSLISTS ':ListsId:'...'
|
||||
Void = msg( '', MsgInfo )
|
||||
return 0
|
||||
end
|
||||
RETURN 0
|
Reference in New Issue
Block a user