*--------------------------------------------------------------------- *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 ":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 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,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,VM) FOR I=1 TO ICT BEGIN CASE CASE OREC[1,1] = "B" READ IREC FROM INVENTORY,OREC THEN OKAY=FALSE IF VALID.TYPES#"" THEN LOCATE(IREC,VALID.TYPES,1;FND) THEN OKAY=TRUE END END ELSE OKAY=TRUE END; * END IF VALID.TYPES# IF OKAY THEN QTY=OREC LOCATE(OREC,IREC,INV$DISTRIBUTION.CHANNEL;FND) THEN SHIPPING=IREC*QTY END ELSE SHIPPING=0 END; * END LOCATE NET=OREC TAX=OREC 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 WREC<2>=OREC WREC<3>=ID LOCATE(OREC,TERM.TABLE,1;FOUND) THEN WREC<4>=TERM.TABLE<2,FOUND> END ELSE WREC<4>="TERMS NOT FOUND" END; * END LOCATE WREC<5>=OREC WREC<6>=OREC WREC<7>=OREC WREC<8>=OREC WREC<9>=OREC WREC<10>=IREC WREC<11>=OREC PARTNER=OREC READ PMREC FROM PM,PARTNER THEN FNAME=TRIM(PMREC:" ":PMREC) 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,VM) FOR M=1 TO MCT BEGIN CASE CASE OREC="SHIPG" ADD.SHIPG=ADD.SHIPG+OREC CASE OREC="TAX" ADD.TAX=ADD.TAX+OREC CASE 1 ADD.OTHER=ADD.OTHER+OREC 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 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