tldm-universe/CMS/BP.CUSTOM/TLD.PICKING.PRINT
2024-09-10 15:25:06 -04:00

430 lines
13 KiB
Plaintext
Executable File

*CMSD.PICKING.PRINT
*--------------------------------------------------------------------
*PGM NAME: CMSD.PICKING.PRINT
*PURPOSE: GENERIC OUTPUT SUBROUTINE FOR REL8 PICKING SLIPS/LABELS
*AUTHOR: AL SURLES
*CREATED: 06-16-94 (Copied from CMSD.PICKING.SUB.P).
*ABS 03-08-95 : Added logic to print SHIP MODE on labels.
*ABS 03-13-95 : Added logic to print order number and run.number
* on picking labels.
*ABS 03-25-95 : Added logic to abbreviate some ship.modes.
*STR 05-25-95 : Modified program to retreive shipping address from
* GEN.KEYS.
*SPA 06-05-95 : Modified program to retrieve client name from GEN.KEYS.
*ABS 06-05-95 : Modified program to distinguish and print SOLD address
* and SHIP address. The layout for the file PM.LABELS did
* change.
*ABS 06-15-95 : Modified program to safeguard from updating the
* ORDER.LABEL.SUMMARY file more than once.
*ABS 07-24-95 : Modified program to print ship mode CODE on labels
* instead of ship mode DESCRIPTION.
*ABS 08-14-95 : Modified program to print 40 characters instead of 38 for
* COMMENTS.
*SPA 08-22-95 : Modified to print SHIP TO address instead of SOLD TO
* address, and to correctly wrap the paragraph regarding
* CC charges from MICAHTEK.
*
*--------------------------------------------------------------------
$INCLUDE BP.MASTER GEN.COMMON
$INCLUDE BP.MASTER PM
$INCLUDE BP.MASTER CMSD.IVD
$INCLUDE BP.MASTER INV
$INCLUDE BP.MASTER PM.LABELS
*
OPEN 'INVENTORY' TO INV ELSE STOP 201,'INV'
OPEN 'PM.LABELS' TO PML ELSE ABORT 201,"PM.LABELS"
OPEN 'PM.LABELS.HOLD' TO PML.HOLD ELSE ABORT 201,"PM.LABELS.HOLD"
OPEN 'ORDER.LABEL.SUMMARY' TO OLS ELSE STOP 201,"ORDER.LABEL.SUMMARY"
OPEN 'FUND.FILE' TO FUND.FILE ELSE ABORT 201,"FUND.FILE"
OPEN 'GEN.KEYS' TO GEN.KEYS ELSE ABORT 201, 'GEN.KEYS'
OPEN "PM.ORDERS" TO PM.ORDERS ELSE ABORT 201,"PM.ORDERS"
*
*
READ COMPANY.ADDRESS FROM GEN.KEYS,"COMPANY.SHIPPING.ADDRESS" ELSE
CRT @(0,22):CL:BEEP:RV:" ERROR - MISSING GK COMPANY.SHIPPING.ADDRESS <return> :":ERV:
INPUT ANY,3
STOP
END
READ COMPANY.NAME FROM GEN.KEYS,"COMPANY.NAME" ELSE
CRT @(0,22):CL:BEEP:RV:" ERROR - MISSING GK COMPANY.NAME <return> ":ERV:
INPUT ANY,3
STOP
END
*
CRT @(0,0):CS
*
CRT @(0,1):"CMSD.PICKING.PRINT"
10 *
ANS=''
CRT @(5,3):" ":RV:" (P) ":ERV:" icking slips, ":RV:" (L) ":ERV:" abels, or ":RV:" (B) ":ERV:" oth"
CRT @(5,5):CL:"Choose ONE of the above option : ":
INPUT ANS
IF ANS=PF3 OR ANS =PF1 THEN STOP
IF ANS="P" OR ANS="L" OR ANS="B" ELSE GO 10
*
20 *
*IF ANS="P" OR ANS="B" THEN
* EXECUTE \SP-ASSIGN HS\
* EXECUTE \SETPTR ,,,,,,AT LJ3SI,FORM 52,NFMT,RETAIN,INFORM,BRIEF,NHEAD,NOKEEP\
*END
*IF ANS="L" THEN
* EXECUTE \SP-ASSIGN HS\
* EXECUTE \SETPTR ,,,,,,AT OTC,FORM 32,NFMT,RETAIN,INFORM,BRIEF,NHEAD,NOKEEP\
*END
IF ANS="L" THEN
CRT @(5,10):CL:RV:" Now select printer for LABELS ":ERV
EXECUTE \EX PRINTER\
END ELSE
CRT @(5,10):CL:RV:" Now select printer for PICKING SLIPS ":ERV
EXECUTE \EX PRINTER\
END
*
CHANNEL=OCONV(0, 'U50BB')
ACCT.NAME=TRIM(FIELD(CHANNEL," ",2))
STARS=STR("_",41)
EOF=0 ; REC.CNT=0 ; SEQ.CNT=0 ; PICKING.SLIP.FLAG=0
CMND=\SSELECT PM.LABELS BY SORT.GROUP BY PRODUCT BY ZIP \
EXECUTE CMND
*
BEGIN CASE
CASE ANS="P" OR ANS="B"
PICKING.SLIP.FLAG=1
LOOP
READNEXT ID ELSE EOF=1
UNTIL EOF DO
READ PML.REC FROM PML,ID THEN
REC.CNT=REC.CNT+1 ; OLS.REC=''
SEQ.CNT=PML.REC<PML$SORT.GROUP>:"*":REC.CNT
IF PML.REC<PML$SHIP1>='' THEN
PML.REC<PML$SHIP1>=PML.REC<PML$SOLD1>
PML.REC<PML$SHIP2>=PML.REC<PML$SOLD2>
PML.REC<PML$SHIP3>=PML.REC<PML$SOLD3>
PML.REC<PML$SHIP4>=PML.REC<PML$SOLD4>
PML.REC<PML$SHIP5>=PML.REC<PML$SOLD5>
PML.REC<PML$SHIP6>=PML.REC<PML$SOLD6>
SHIPTO=0
END ELSE
SHIPTO=1
END
GOSUB 1000 ;*---define variables
GOSUB 2000 ;*---print picking slips
PRINT CHAR(12)
READ PMLH.REC FROM PML.HOLD,ID ELSE
IF OLS.REC#'' THEN WRITE OLS.REC ON OLS,OLS.KEY
WRITE PML.REC ON PML.HOLD,ID
END
IF ANS="P" THEN DELETE PML,ID
END
REPEAT
PRINT CHAR(12)
PRINTER OFF
IF ANS="B" THEN ANS="L" ; EXECUTE "SP.CLOSE" ; GO 20
CASE ANS="L"
PRINTER ON
GOSUB 7500 ;* format gen.keys shipping name
ADDRESS<6>=STARS
LOOP
READNEXT ID ELSE EOF=1
UNTIL EOF DO
READ PML.REC FROM PML,ID THEN
ADDRESS<7>=PML.REC<PML$SHIP.MODE,2>'R#40'
IF PML.REC<PML$SHIP.MODE,2>='' THEN ADDRESS<7>=PML.REC<PML$SHIP.MODE,1>'R#40'
PN.CLT=TRIM(PML.REC<PML$PARTNER>:"-":ACCT.NAME)
ADDRESS<8>=PN.CLT'R#40'
INV.NUM=OCONV(ID,"G0*1") ; RUN.NUM=OCONV(ID,"G1*1")
CLT.INV.RUN=TRIM(ACCT.NAME:"-":INV.NUM:"-":RUN.NUM)
ADDRESS<9>=CLT.INV.RUN'R#40'
ADDRESS<10>=ACCT.NAME'R#40'
REC.CNT=REC.CNT+1
SEQ.CNT=TRIM(PML.REC<PML$SORT.GROUP>:"*":REC.CNT)
ADDRESS<11>=SEQ.CNT'R#40'
FOR X=13 TO 18
IF X=13 THEN
IF PML.REC<PML$SHIP1>#'' THEN
ADDRESS<X>="TO:":SPACE(6):PML.REC<X+21>
END ELSE
ADDRESS<X>="TO:":SPACE(6):PML.REC<X-12>
END
END ELSE
IF PML.REC<PML$SHIP1>#'' THEN
ADDRESS<X>=SPACE(9):PML.REC<X+21>
END ELSE
IF X=18 THEN
ADDRESS<X>=SPACE(9):PML.REC<X+25>
END ELSE
ADDRESS<X>=SPACE(9):PML.REC<X-12>
END
END
END
NEXT X
FOR X=1 TO 18
PRINT ADDRESS<X>'L#40'
NEXT X
IF NOT(PICKING.SLIP.FLAG) THEN WRITE PML.REC ON PML.HOLD,ID
DELETE PML,ID
END
REPEAT
PRINT CHAR(12)
*
CASE 1
END CASE
*
PRINTER OFF
EXECUTE \SETPTR ,,,,,,BRIEF\
CRT @(0,22):CL:"PROCESS IS COMPLETE" :
INPUT DUMMY
ENTER MSD.PICKING.RPT
*
STOP
*
*
1000 *---define variables and build output arrays
ROW=0
BO.SWITCH=''
B=999
SP1=SPACE(1); SP2=SPACE(2) ; SP3=SPACE(3) ; SP5=SPACE(5); SP10=SPACE(10)
PARTNER=PML.REC<PML$PARTNER>
TODAY=OCONV(DATE(),'D2/')
ORDER=OCONV(ID,"G0*1")
ORDER.DATE=OCONV(PML.REC<PML$BATCH.DT>,'D2/')
PO.NUM=PML.REC<PML$PO.NUMBER>
IDATE=ICONV(TODAY,"D") ; RUN.NUMBER=OCONV(ID,"G1*1")
OLS.KEY=ORDER:"*":RUN.NUMBER
EVENT=PML.REC<PML$EVENT>
*
TERMS=OCONV(PML.REC<PML$TERMS>,"MCU")
*
SHIP.VIA=PML.REC<PML$SHIP.MODE,1>
*
RETURN
*
2000 *
TOTAL.ORDER=PML.REC<PML$BALANCE>
PG=1
PRINTER ON
GOSUB 2100 ;* PRINT TOP PART OF FORM
TT=DCOUNT(PML.REC<PML$REL.ITEM>,VM)
FOR I=1 TO TT
ITEM=PML.REC<PML$REL.ITEM,I>
READ INV.REC FROM INV,ITEM THEN
SHELF.LOC=INV.REC<INV$PRIMARY.LOCATION>
END ELSE
SHELF.LOC=""
END
QTY=PML.REC<PML$REL.QTY,I>
DESC=PML.REC<PML$REL.DESC,I>
XAMT=PML.REC<PML$REL.AMOUNT,I>
LN=SP1:QTY'R#4':SP2:QTY'R#4':SPACE(3):SHELF.LOC'L#5':ITEM'L#7'
*LN=LN:SP3:DESC'L#30':SP10:XAMT'R26(#7)'
*== added KJC - 11/10/99
BOYES=0
READ PMOREC FROM PM.ORDERS,ORDER THEN
LOCATE(ITEM,PMOREC,IVD$ITEM;ILOC) THEN
ITEMSTAT=PMOREC<IVD$ITEM.STATUS,ILOC>
IF INDEX(ITEMSTAT,"B",1) THEN BOYES=1
END
END
IF BOYES THEN
LN=LN:SPACE(1):"Y"'L#4':DESC'L#28':SP10:XAMT'R26(#7)'
END ELSE
LN=LN:SPACE(5):DESC'L#28':SP10:XAMT'R26(#7)'
END
*==
GOSUB 2200 ;* PRINT A LINE
IF PML.REC<PML$PK.ITEM,I>#'' THEN
CI.CNT=DCOUNT(PML.REC<PML$PK.ITEM,I>,SVM)
FOR CI=1 TO CI.CNT
LN="-----PK ITEM----- ":PML.REC<PML$PK.ITEM,I,CI>'L#12'
LN=LN:PML.REC<PML$PK.DESC,I,CI>'L#30'
CI.QTY="(":PML.REC<PML$PK.QTY,I,CI>:")"
LN=LN:CI.QTY'R#6'
GOSUB 2200 ; * PRINT A LINE
NEXT CI
LN='' ; GOSUB 2200
END
*-- build record for ORDER.LABEL.SUMMARY file --
IF OLS.REC='' THEN
OLS.REC<1>=PARTNER:VM:ORDER
OLS.REC<2>=ITEM
OLS.REC<3>=QTY
OLS.REC<4>="P1"
OLS.REC<5>=IDATE
END ELSE
OLS.REC<2>=OLS.REC<2>:VM:ITEM
OLS.REC<3>=OLS.REC<3>:VM:QTY
END
NEXT I
*
MISC.ARRAY=''
FOR B=1 TO 5
MISC.ARRAY<B>=PML.REC<B+22>
NEXT B
MCT=DCOUNT(MISC.ARRAY,VM)
FOR M=1 TO MCT
MTYPE=MISC.ARRAY<1,M>
MITEM=MISC.ARRAY<2,M>
MAMOUNT=MISC.ARRAY<3,M>
BEGIN CASE
CASE MTYPE='SHIPG'
LN=SPACE(31):"SHIPPING AND HANDLING":SPACE(15):MISC.ARRAY<3,M>'R26,(#9)'
GOSUB 2200
CASE MTYPE='HANDG'
LN=SPACE(31):"C.O.D. CHARGE":SPACE(25):MISC.ARRAY<3,M>'R26,(#7)'
GOSUB 2200
CASE MTYPE='COD'
LN=SPACE(31):"COD CHARGE":SPACE(28):MISC.ARRAY<3,M>'R26,(#7)'
GOSUB 2200
CASE MTYPE='PLG'
LN=SPACE(31):"PLEDGE PAYMENT":SPACE(24):MISC.ARRAY<3,M>'R26,(#7)'
GOSUB 2200
CASE MTYPE='FUND'
READV FDESC FROM FUND.FILE,MISC.ARRAY<2,M>,1 ELSE FDESC="FUND PAYMENT"
LN=SPACE(31):FDESC'L#30':SPACE(8):MISC.ARRAY<3,M>'R26,(#7)'
GOSUB 2200
CASE MTYPE='SUBS'
LN=SPACE(31):"SUBSCRIPTION PAYMENT":SPACE(18):MISC.ARRAY<3,M>'R26,(#7)'
GOSUB 2200
CASE MTYPE='APPLY'
LN=SPACE(31):"CREDIT MEMO APPLIED":SPACE(19):MISC.ARRAY<3,M>'R26,(#7)'
GOSUB 2200
CASE MTYPE='CRMEM'
LN=SPACE(31):"CREDIT MEMO CREATED":SPACE(19):MISC.ARRAY<3,M>'R26,(#7)'
GOSUB 2200
END CASE
NEXT M
LN=''
GOSUB 2200
BCT=DCOUNT(PML.REC<PML$BO.ITEM>,VM)
* ------ DJL - ADDED BACKORDER PRINT LOGIC ------ *
FOR B=1 TO BCT
BO.SWITCH=1
ITEM=PML.REC<PML$BO.ITEM,B>
QTY=PML.REC<PML$BO.QTY,B>
DESC=PML.REC<PML$BO.DESC,B>
LN=SPACE(13):QTY'R#4':SP2:ITEM'L#7'
LN=LN:SPACE(5):DESC'L#30'
GOSUB 2200 ;* PRINT A LINE
NEXT B
LN=''
GOSUB 2200
OCT=DCOUNT(PML.REC<PML$COMMENTS>,VM)
FOR O=1 TO OCT
IF PML.REC<PML$COMMENTS,O> # '' THEN
LN=SPACE(29):PML.REC<PML$COMMENTS,O>'L#40'
GOSUB 2200
END
NEXT O
LN=''
GOSUB 2200
LN=SPACE(43):'AMOUNT DUE THIS INVOICE':TOTAL.ORDER'R26,$(#10)'
GOSUB 2200
IF PML.REC<PML$CC.BO.FLAG>='Y' THEN ;* balance on order to be charged!
GOSUB 2200
GOSUB 2200
LN=SPACE(5):"**Credit card charges will be made when back-ordered products are shipped."
GOSUB 2200
END
*IF TERMS='CREDIT CARD' THEN
* GOSUB 2200
* GOSUB 2200
* LN="Dear ":PML.REC<1>:":"
* GOSUB 2200
* GOSUB 2200
** FOR THE WORD WRAP LOGIC TO WORK, THERE MUST BE A BLANK LINE AT THE END
** OF LN1 BELOW!
* LN1="Please notice when your credit card statement arrives that the order you have received will reflect a charge under the name 'MICAHTEK' rather than ":OCONV(COMPANY.NAME,"MCT"):". MICAHTEK is a 1-800 number fulfillment center responsible for shipping our products to you. "
* LOOP
* LNLEN=LEN(LN1)
* UNTIL LNLEN=0 DO
* NUM.SPACES=COUNT(LN1," ")
* IDX=99
* FOR XX=NUM.SPACES TO 1 STEP -1 UNTIL IDX LE 80
* IDX=INDEX(LN1," ",XX)
* NEXT XX
* LN=LN1[1,IDX-1]
* GOSUB 2200
* LN1=LN1[IDX+1,LNLEN]
* REPEAT
* GOSUB 2200
* GOSUB 2200
* LN="Thank You and may God Bless You!"
* GOSUB 2200
*END
RETURN
*
2100 *---print top part of form----
*PRINT; PRINT; PRINT; PRINT
PRINT
PRINT SP2:COMPANY.NAME
PRINT SP2:COMPANY.ADDRESS<1,1>'L#38':SP5:"Order Number: ":ORDER'L#10'
PRINT SP2:COMPANY.ADDRESS<1,2>'L#38':SP5:"Print Date: ":IDATE'L#8'
PRINT SP2:COMPANY.ADDRESS<1,3>'L#38':SP5:"Print Run #: ":RUN.NUMBER'L#5':SEQ.CNT'R#8'
PRINT SP2:COMPANY.ADDRESS<1,4>'L#38':SP5:"Partner Number: ":PARTNER'L#10'
PRINT SP2:COMPANY.ADDRESS<1,5>'L#38'
PRINT SPACE(45):"Batch Date: ":ORDER.DATE'L#15'
PRINT SP2:"SOLD TO:"'L#38':SP5:"Ship Via: ":SHIP.VIA'L#15'
PRINT SPACE(45):"Terms: ":TERMS'L#15'
PRINT SP2:PML.REC<PML$SOLD1>'L#38':SP5:"PO Number: ":PO.NUM'L#15'
PRINT SP2:PML.REC<PML$SOLD2>'L#38':SP5
PRINT SP2:PML.REC<PML$SOLD3>'L#38':SP5:"SHIPPED TO:"
IF SHIPTO THEN
PRINT SP2:PML.REC<PML$SOLD4>'L#38':SP5:PML.REC<PML$SHIP1>'L#35'
PRINT SP2:PML.REC<PML$SOLD5>'L#38':SP5:PML.REC<PML$SHIP2>'L#35'
PRINT SP2:PML.REC<PML$SOLD6>'L#38':SP5:PML.REC<PML$SHIP3>'L#35'
PRINT SPACE(45):PML.REC<PML$SHIP4>'L#35'
PRINT SPACE(45):PML.REC<PML$SHIP5>'L#35'
END ELSE
PRINT SP2:PML.REC<PML$SOLD4>'L#38'
PRINT SP2:PML.REC<PML$SOLD5>'L#38'
PRINT SP2:PML.REC<PML$SOLD6>'L#38'
PRINT
PRINT
END
*
PRINT STR('-',79)
PRINT " QTY QTY SLF ITEM BO DESCRIPTION AMOUNT"
PRINT " ORD SHP LOC SHPD"
PRINT STR('-',79)
ROW=26
RETURN
*
2200 *---print a detail line----
IF ROW=60 THEN PRINT CHAR(12); GOSUB 2100 ; ROW=26
* ------ DJL - ADDED BACKORDER PRINTOUT LOGIC ------ *
IF BO.SWITCH AND B LE 1 THEN
PRINT
PRINT
BO.LN=SPACE(31):"BACKORDERED PRODUCT(S):"
PRINT BO.LN
PRINT
PRINT LN
ROW=ROW+5
LN=''
BO.SWITCH=''
END ELSE
PRINT LN
ROW=ROW+1
LN=''
BO.SWITCH=''
END
RETURN
*
*
7500 *------------ format company address to print on label ---------*
*--- center address on label -------------*
LADD1=(40 - LEN(COMPANY.ADDRESS<1,1>)) / 2
LADD2=(40 - LEN(COMPANY.ADDRESS<1,2>)) / 2
LADD3=(40 - LEN(COMPANY.ADDRESS<1,3>)) / 2
LADD4=(40 - LEN(COMPANY.ADDRESS<1,4>)) / 2
ADDRESS=''
*ADDRESS<2>='FROM:':SPACE(LADD1-1):COMPANY.ADDRESS<1,1>
*ADDRESS<3>=SPACE(LADD2+3):COMPANY.ADDRESS<1,2>
*ADDRESS<4>=SPACE(LADD3+3):COMPANY.ADDRESS<1,3>
*ADDRESS<5>=SPACE(LADD4+3):COMPANY.ADDRESS<1,4>
ADDRESS<2>=''
ADDRESS<3>=''
ADDRESS<4>=''
ADDRESS<5>=''
RETURN
*