tldm-universe/CMS/BP.CUSTOM/CMSD.BORDER.RPT.TLD
2024-09-10 15:25:06 -04:00

463 lines
13 KiB
Plaintext
Executable File

*---------------------------------------------------------------------
*PGM NAME: CMSD.BORDER.RPT.TLD
*PURPOSE: BACKORDER REPORT BY DATE RANGE BY CHANNEL
*AUTHOR: TERRY HODO
*CREATED: 12/28/94
*UPDATES:
*ABS 02-01-96: Adjusted the MAX.LINES FROM 59 TO 57.
*KJC 11-11-99: Added PM info on report - removed Terms,etc
*---------------------------------------------------------------------
$INCLUDE BP.MASTER GEN.COMMON
$INCLUDE BP.MASTER CMSD.IVD
$INCLUDE BP.MASTER INV
$INCLUDE BP.MASTER PM
*
EQU TRUE TO 1
EQU FALSE TO 0
COMMA=","
UPDATE=FALSE
*
OPEN 'PM' TO PM ELSE ABORT 201,'PM'
OPEN 'PM.ORDERS' TO PM.ORDERS ELSE ABORT 201,'PM.ORDERS'
OPEN 'PM.ORDERS.INDEX.BACKORDER' TO PM.ORDERS.INDEX.BACKORDER ELSE ABORT
OPEN 'GEN.KEYS' TO GEN.KEYS ELSE ABORT 201,'GEN.KEYS'
OPEN 'INVENTORY' TO INVENTORY ELSE ABORT 201,'INVENTORY'
OPEN 'SALES.WORK.BO.TLD' TO SALES.WORK ELSE
EXECUTE "CREATE-FILE SALES.WORK.BO.TLD 1,4 53,4"
OPEN 'SALES.WORK.BO.TLD' TO SALES.WORK ELSE ABORT 201,'SALES.WORK.BO.TLD'
OPEN 'DICT SALES.WORK.BO.TLD' TO DFILE THEN
ITYPE="A":AM:10:"TYPE":AM:AM:AM:AM:AM:AM:"L":AM:5
WDATE="A":AM:2:AM:"DATE":AM:AM:AM:AM:AM:AM:"R":AM:10
WITEM="A":AM:1:AM:"ITEM":AM:AM:AM:AM:AM:AM:"L":AM:10
WRITE ITYPE ON DFILE,"ITYPE" ELSE ABORT
WRITE WDATE ON DFILE,"DATE" ELSE ABORT
WRITE WITEM ON DFILE,"ITEM" ELSE ABORT
END
END
OPEN 'DICT SALES.WORK.BO.TLD' TO DFILE THEN
ITYPE="A":AM:10:"TYPE":AM:AM:AM:AM:AM:AM:"L":AM:5
WDATE="A":AM:2:AM:"DATE":AM:AM:AM:AM:AM:AM:"R":AM:10
WITEM="A":AM:1:AM:"ITEM":AM:AM:AM:AM:AM:AM:"L":AM:10
WRITE ITYPE ON DFILE,"ITYPE" ELSE ABORT
WRITE WDATE ON DFILE,"DATE" ELSE ABORT
WRITE WITEM ON DFILE,"ITEM" ELSE ABORT
END
*
READ TYPE.TABLE FROM GEN.KEYS,"INVADD.PRODUCT.TYPE" ELSE TYPE.TABLE=""
READ TERM.TABLE FROM GEN.KEYS,"PAYMENT.TERMS" ELSE TERM.TABLE=""
READ CHANNEL.TABLE FROM GEN.KEYS,"CHANNEL.CODES" ELSE CHANNEL.TABLE=""
READ COMPANY.NAME FROM GEN.KEYS,"COMPANY.NAME" ELSE
CRT @(0,22):CL:BEEP:RV:" ERROR - MISSING GEN.KEYS COMPANY.NAME <return> ":ERV:
INPUT ANY,3
STOP
END
*
SCREEN=""
SCREEN=SCREEN:CS
SCREEN=SCREEN:@(0,0):RV:"CMSD.BORDER.RPT.TLD BACKORDER RPTS BY TYPE BY CHANNEL ":TIMEDATE():ERV
SCREEN=SCREEN:@(0,5):"1. Type Codes:"
SCREEN=SCREEN:@(0,6):"2. Channel Codes:"
SCREEN=SCREEN:@(0,7):"3. Starting Date:"
SCREEN=SCREEN:@(0,8):"4. Ending Date:"
SCREEN=SCREEN:@(0,9):"5. Printer Queue:"
CRT SCREEN
*
10 *--input type codes
VALID.TYPES=""
CRT @(20,5):CL
CRT @(0,22):CL:"Enter desired Type Codes separated by commas or 'ALL'":
ANS=""; INPUT ANS
ANS=TRIM(ANS)
IF ANS="/" THEN STOP
IF ANS="" THEN ANS="ALL"
IF ANS="ALL" THEN
VALID.TYPES=""
CRT @(20,5):RV:"ALL":ERV
END ELSE
TYPE.COUNT=DCOUNT(ANS,COMMA)
FOR X=1 TO TYPE.COUNT
TYPE=FIELD(ANS,COMMA,X)
LOCATE(TYPE,TYPE.TABLE,1;FND) THEN
LOCATE(TYPE,VALID.TYPES,1;FND;'AL') ELSE
VALID.TYPES=INSERT(VALID.TYPES,1,FND;TYPE)
END
END
NEXT X
IF VALID.TYPES="" THEN
CRT @(0,22):CL:"No valid Type Codes were entered - Please try again...":
RQM; GO 10
END
POS=0
TYPE.COUNT=DCOUNT(VALID.TYPES<1>,VM)
FOR X=1 TO TYPE.COUNT
CRT @(20+POS,5):RV:VALID.TYPES<1,X>:ERV
POS=POS+4
NEXT X
END
IF UPDATE THEN RETURN
*
20 *--input channel codes
VALID.CHANNELS=""
CRT @(20,6):CL
CRT @(0,22):CL:"Enter desired Channel Codes separated by commas or 'ALL'":
ANS=""; INPUT ANS
ANS=TRIM(ANS)
IF ANS="/" THEN STOP
IF ANS="" THEN ANS="ALL"
IF ANS="ALL" THEN
VALID.CHANNELS=""
CRT @(20,6):RV:"ALL":ERV
END ELSE
CHANNEL.COUNT=DCOUNT(ANS,COMMA)
FOR X=1 TO CHANNEL.COUNT
CHANNEL=FIELD(ANS,COMMA,X)
LOCATE(CHANNEL,CHANNEL.TABLE,1;FND) THEN
LOCATE(CHANNEL,VALID.CHANNELS,1;FND;'AL') ELSE
VALID.CHANNELS=INSERT(VALID.CHANNELS,1,FND;CHANNEL)
END
END
NEXT X
IF VALID.CHANNELS="" THEN
CRT @(0,22):CL:"No valid Channel Codes were entered - Please try again...":
RQM; GO 20
END
POS=0
CHANNEL.COUNT=DCOUNT(VALID.CHANNELS<1>,VM)
FOR X=1 TO CHANNEL.COUNT
CRT @(20+POS,6):RV:VALID.CHANNELS<1,X>:ERV
POS=POS+6
NEXT X
END
IF UPDATE THEN RETURN
*
30 *--input starting date
SDATE=""
SDATE = DATE()
*CRT @(20,7):CL
*CRT @(0,22):CL:"Enter desired Starting Date (MM/DD/YY)":
*ANS=""; INPUT ANS
*ANS=TRIM(ANS)
*IF ANS="/" THEN STOP
*SDATE=ICONV(ANS,"D")
*IF SDATE MATCHES "0N" AND SDATE#0 AND SDATE#"" ELSE
* CRT @(0,22):CL:"Invalid Response! - Please try again...":
* RQM; GO 30
*END
START.DATE=OCONV(SDATE,"D2/")
CRT @(20,7):RV:START.DATE'L#8':ERV
IF UPDATE THEN RETURN
*
40 *--input ending date
EDATE=""
EDATE = DATE()
*CRT @(20,8):CL
*CRT @(0,22):CL:"Enter desired Ending Date (MM/DD/YY)":
*ANS=""; INPUT ANS
*ANS=TRIM(ANS)
*IF ANS="/" THEN STOP
*EDATE=ICONV(ANS,"D")
*IF EDATE MATCHES "0N" AND EDATE#0 AND EDATE#"" ELSE
* CRT @(0,22):CL:"Invalid Response! - Please try again...":
* RQM; GO 40
*END
END.DATE=OCONV(EDATE,"D2/")
CRT @(20,8):RV:END.DATE'L#8':ERV:
IF UPDATE THEN RETURN
*
50 *--input printer queue and set spool assignment
CRT @(0,11):CL
EXECUTE "EX PRINTER"
PRINT.FLAG=TRUE
IF UPDATE THEN RETURN
*
60 *
UPDATE=TRUE
LOOP
CRT @(0,22):CL:"Enter ## to change, /(escape) or <return> to continue...":
RSP=""; INPUT RSP
BEGIN CASE
CASE RSP=1; GOSUB 10 ;*--input valid types
CASE RSP=2; GOSUB 20 ;*--input valid channels
CASE RSP=3; GOSUB 30 ;*--input starting date
CASE RSP=4; GOSUB 40 ;*--input ending date
CASE RSP=5; GOSUB 50 ;*--input printer queue and set spool assignment
CASE RSP="/"
CASE RSP=""
CASE 1
CRT @(0,22):CL:"Invalid Response! - Please try again...":; RQM
END CASE
UNTIL RSP="" OR RSP="/" DO
REPEAT
*IF ANS="CRT" THEN EXECUTE \T132\
IF RSP="" THEN GOSUB 1000
IF PRINT.FLAG ELSE
EXECUTE \T80\
END
STOP
*
1000 *--build workfile and generate report
CRT @(0,12):CR:"Record selection in progress - please wait...":
EXECUTE \CLEAR-FILE DATA SALES.WORK.BO\ CAPTURING JUNK
EOF=FALSE; REFRESH=100; REJECTS=""; KEY=0
NUM.READ=0; NUM.SELECTED=0; NUM.REJECTED=0
ADD.SHIPG=0; ADD.TAX=0; ADD.OTHER=0
SELECT PM.ORDERS.INDEX.BACKORDER
*EXECUTE \GET-LIST TWH\
LOOP
READNEXT ID ELSE EOF=TRUE
UNTIL EOF DO
IF REM(NUM.READ,REFRESH) ELSE GOSUB 3000
GOSUB 2000 ;*--build workfile based on selection criteria
REPEAT
GOSUB 3000 ;*--refresh totals
GOSUB 5000 ;*--process report
RETURN
*
2000 *--process record
REJECTED=FALSE
READ OREC FROM PM.ORDERS,ID THEN
NUM.READ=NUM.READ+1
*LOCATE("SHP",OREC,IVD$TRACK.ACTION;FND) THEN
IF VALID.CHANNELS#"" THEN
LOCATE(OREC<IVD$CHANNEL>,VALID.CHANNELS,1;FND) ELSE
REJECTED=TRUE
NUM.REJECTED=NUM.REJECTED+1
END
END
*END ELSE
*REJECTED=TRUE
*NUM.REJECTED=NUM.REJECTED+1
*END; * END LOCATE CHANNEL
IF NOT(REJECTED) THEN
WRITE.FLAG=FALSE
ALL.BO = TRUE
ICT=DCOUNT(OREC<IVD$ITEM>,VM)
FOR I=1 TO ICT
BEGIN CASE
CASE OREC<IVD$ITEM.STATUS,I>[1,1] = "B"
READ IREC FROM INVENTORY,OREC<IVD$ITEM,I> THEN
OKAY=FALSE
IF VALID.TYPES#"" THEN
LOCATE(IREC<INV$TYPE.CODE>,VALID.TYPES,1;FND) THEN
OKAY=TRUE
END
END ELSE
OKAY=TRUE
END; * END IF VALID.TYPES#
IF OKAY THEN
QTY=OREC<IVD$QTY,I>
LOCATE(OREC<IVD$CHANNEL>,IREC,INV$DISTRIBUTION.CHANNEL;FND) THEN
SHIPPING=IREC<INV$CHANNEL.SHIPPING,FND>*QTY
END ELSE
SHIPPING=0
END; * END LOCATE
NET=OREC<IVD$LINE.NET.AMOUNT,I>
TAX=OREC<IVD$LINE.SALES.TAX.AMT,I>
RESULT1=NET-TAX
RESULT2=RESULT1-SHIPPING
IF RESULT2 LT 0 THEN
NET.AMOUNT=0
SHIPPING=RESULT1
END ELSE
NET.AMOUNT=RESULT1-SHIPPING
END; * END IF RESULT2
KEY=KEY+1
WREC=""
WREC<1>=OREC<IVD$ITEM,I>
WREC<2>=OREC<IVD$DATE.ORDERED>
WREC<3>=ID
LOCATE(OREC<IVD$TERMS>,TERM.TABLE,1;FOUND) THEN
WREC<4>=TERM.TABLE<2,FOUND>
END ELSE
WREC<4>="TERMS NOT FOUND"
END; * END LOCATE
WREC<5>=OREC<IVD$QTY,I>
WREC<6>=OREC<IVD$LINE.NET.AMOUNT,I>
WREC<7>=OREC<IVD$TOTAL.PAID>
WREC<8>=OREC<IVD$BALANCE>
WREC<9>=OREC<IVD$NET.ORDER.AMOUNT>
WREC<10>=IREC<INV$TYPE.CODE>
WREC<11>=OREC<IVD$CHANNEL>
PARTNER=OREC<IVD$PARTNER,1>
READ PMREC FROM PM,PARTNER THEN
FNAME=TRIM(PMREC<PM$FNAME>:" ":PMREC<PM$LNAME>)
WREC<12>=PARTNER
WREC<13>=FNAME
END
WRITE WREC ON SALES.WORK,KEY'R%8'
WRITE.FLAG=TRUE
END; * END IF OKAY
END; * END READ IREC
CASE 1; ALL.BO = FALSE
END CASE
NEXT I
IF WRITE.FLAG AND ALL.BO THEN
MCT=DCOUNT(OREC<IVD$MISC.CHARGE.TYPE>,VM)
FOR M=1 TO MCT
BEGIN CASE
CASE OREC<IVD$MISC.CHARGE.TYPE,M>="SHIPG"
ADD.SHIPG=ADD.SHIPG+OREC<IVD$MISC.CHARGE.AMOUNT,M>
CASE OREC<IVD$MISC.CHARGE.TYPE,M>="TAX"
ADD.TAX=ADD.TAX+OREC<IVD$MISC.CHARGE.AMOUNT,M>
CASE 1
ADD.OTHER=ADD.OTHER+OREC<IVD$MISC.CHARGE.AMOUNT,M>
END CASE
NEXT M
END; * END IF WRITE.FLAG
END; * END IF (NOT)REJECTED
END; * END READ OREC
RETURN
*
3000 *
CRT @(0,14):"Number order records read: ":NUM.READ
CRT @(0,15):"Number order records rejected: ":NUM.REJECTED
RETURN
*
5000 *
CRT @(0,19):CR:"Now generating the report - please wait..."
EXECUTE \SSELECT SALES.WORK.BO.TLD BY ITYPE BY ITEM BY DATE\ CAPTURING JUNK
IF PRINT.FLAG THEN PRINTER ON
HDG1="CMSD.BORDER.RPT.TLD":SPACE(28):TIMEDATE():" Page "
COLEN=LEN(COMPANY.NAME)
COLEN=(80-COLEN)/2
HDG2=SPACE(COLEN):OCONV(COMPANY.NAME,"MCT")
HDG3=SPACE(25):"Backorder Items as of ":START.DATE
HDG4="ITEM DONOR# NAME QTY DATE ORDER#"
HDG5="--------------------------------------------------------------------------------"
*
IF PRINT.FLAG THEN
MAX.LINES = 57
END ELSE
MAX.LINES = 22
END
LNCT = 0; PGCNT = 0
PREVIOUS.BREAK="ZZZ"
PREVIOUS.ITEM = "ZZZ"
FIRST.RECORD=TRUE
SUB.QTY=0; SUB.NET=0; SUB.PAID=0; SUB.DUE=0; SUB.ORD.AMT=0
GRAND.NET=0
EOF=FALSE
LOOP
READNEXT ID ELSE EOF=TRUE
UNTIL EOF DO
GOSUB 5100 ;*--process work record
REPEAT
GOSUB 5200 ;*--print sub-totals
*GOSUB 5300 ;*--print grand totals
PRINTER OFF
CRT @(0,22):CR:"Report is complete! - Press <return> to continue...":
ANY=""; INPUT ANY
RETURN
*
5100 *--process work record
READ REC FROM SALES.WORK,ID THEN
IF REC<1>#PREVIOUS.BREAK THEN
IF PREVIOUS.ITEM = "ZZZ" THEN
PREVIOUS.ITEM = REC<1>
END
PREVIOUS.BREAK=REC<1>
IF NOT(FIRST.RECORD) THEN GOSUB 5200 ;*--print sub-totals
SUB.QTY=0; SUB.NET=0; SUB.PAID=0; SUB.DUE=0; SUB.ORD.AMT=0
END
SUB.QTY=SUB.QTY+REC<5>
SUB.NET=SUB.NET+REC<6>
SUB.PAID=SUB.PAID+REC<7>
SUB.DUE=SUB.DUE+REC<8>
SUB.ORD.AMT=SUB.ORD.AMT+REC<9>
IF LNCT+1 > MAX.LINES THEN
FOR LL=LNCT TO MAX.LINES
LN=""
GOSUB 8000 ;*--print a detail line
NEXT LL
END
LN=""
LN=LN:REC<1>'L#8':SPACE(2)
OUTDATE = OCONV(REC<2>,"D2/")
*LN=LN:OUTDATE'L#8':" "
*LN=LN:REC<3>'R#7' :" "
*LN=LN:REC<4>'L#14':" "
*LN=LN:REC<5>'R#5':" "
*LN=LN:REC<6>'R26,#11':" "
*LN=LN:REC<9>'R26,#11':" "
*LN=LN:REC<7>'R26,#11':" "
*LN=LN:REC<8>'R26,#11'
LN=LN:REC<12>'L#12':SPACE(2)
LN=LN:REC<13>'L#26':SPACE(2)
LN=LN:REC<5>'R#6':SPACE(4)
LN=LN:OUTDATE'L#8':SPACE(2)
LN=LN:REC<3>'R#8'
GOSUB 8000
END
RETURN
*
5200 *--print sub-totals
IF LNCT+3 > MAX.LINES THEN
FOR LL=LNCT TO MAX.LINES
LN=""
GOSUB 8000 ;*--print a detail line
NEXT LL
END
LN=""; GOSUB 8000
LN=LN:PREVIOUS.ITEM'L#8':" ":"Sub-Totals:":SPACE(28)
LN=LN:SUB.QTY'R#9' ;* :" ":SUB.NET'R26,#11':" "
*LN=LN:SUB.ORD.AMT'R26,#11':" ":SUB.PAID'R26,#11':" ":SUB.DUE'R26,#11'
GOSUB 8000
LN=""; GOSUB 8000
GRAND.NET=GRAND.NET+SUB.NET
PREVIOUS.ITEM = PREVIOUS.BREAK
RETURN
*
5300 *--print grand-totals
IF LNCT+6 > MAX.LINES THEN
FOR LL=LNCT TO MAX.LINES
LN=""
GOSUB 8000 ;*--print a detail line
NEXT LL
END
LN=""; GOSUB 8000
GRAND.NET = GRAND.NET + ADD.OTHER + ADD.SHIPG + ADD.TAX
LN="Additional Misc. Charges:":SPACE(27):ADD.OTHER'R26,#11'
GOSUB 8000
LN="Additional S/H: ":SPACE(27):ADD.SHIPG'R26,#11'
GOSUB 8000
LN="Total Sales Tax: ":SPACE(27):ADD.TAX'R26,#11'
GOSUB 8000
LN=SPACE(52):"-----------"
GOSUB 8000
LN="GRAND TOTAL:":SPACE(40):GRAND.NET'R26,#11'
GOSUB 8000
PRINT
PRINT
RETURN
*
8000 *--print a detail line
IF FIRST.RECORD THEN
FIRST.RECORD=FALSE
GOSUB 8100
END
IF LNCT > MAX.LINES THEN GOSUB 8100 ;*--print heading data
PRINT LN
LNCT=LNCT+1
RETURN
*
8100 *--print heading data
IF PRINT.FLAG THEN
PRINT CHAR(12)
END ELSE
CRT @(0,22):CL:"Press return for next page...":
ANY=""; INPUT ANY
IF ANY="Q" OR ANY="/" THEN STOP
END
HOLD.LINE=LN
LNCT=0; PGCNT=PGCNT+1
LN=""; GOSUB 8000
LN=HDG1:PGCNT'R#4'; GOSUB 8000
LN=HDG2; GOSUB 8000
LN=HDG3; GOSUB 8000
LN=""; GOSUB 8000
LN=HDG4; GOSUB 8000
LN=HDG5; GOSUB 8000
LN=""; GOSUB 8000
LN=HOLD.LINE
RETURN