From 7378a79fc8588500f0d54e19c9dc2b4e57ceb65f Mon Sep 17 00:00:00 2001 From: John Paul Wohlscheid Date: Tue, 10 Sep 2024 20:27:25 +0000 Subject: [PATCH] upload example program --- CMSD.PICKING.TLD.txt | 403 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 403 insertions(+) create mode 100644 CMSD.PICKING.TLD.txt diff --git a/CMSD.PICKING.TLD.txt b/CMSD.PICKING.TLD.txt new file mode 100644 index 0000000..37d33e3 --- /dev/null +++ b/CMSD.PICKING.TLD.txt @@ -0,0 +1,403 @@ +*-------------------------------------------------------------------- +*PGM NAME: CMSD.PICKING +*PURPOSE: PICKING SLIP QUALIFY ROUTINE FOR REL8 +*AUTHOR: BARKSDALE +*CREATED: 01-06-93 +*UPDATES: +* +*08/21/95 - DJL - :Changed logic so GEN KEYS "ORDER.RUN" will not be +* update when there are no records selected to print +* also no SHIPPER.INDEX file will be created. +*-------------------------------------------------------------------- +$INCLUDE GEN.COMMON +$INCLUDE PM +$INCLUDE CMSD.IVD +* +OPEN 'PM' TO PM ELSE ABORT +OPEN 'PM.TRANS' TO PM.TRANS ELSE ABORT +OPEN 'PM.ORDERS' TO PMO ELSE ABORT +OPEN 'PM.ORDERS.INDEX.RELEASED' TO RINDEX ELSE ABORT +OPEN 'PM.LABELS' TO PM.LABELS ELSE ABORT +OPEN 'INVENTORY' TO INVENTORY ELSE ABORT +OPEN 'GEN.KEYS' TO GEN.KEYS ELSE ABORT +OPEN 'PT' TO PT ELSE ABORT +OPEN 'CM' TO CM ELSE ABORT +OPEN 'BATCH.XREF' TO BATCH.XREF ELSE ABORT +OPEN 'BA' TO BA ELSE ABORT +* +CHECK.FILE.FLAG=1 +CALL SYSTEM.SETUP +MAX.SHIPMENTS=SYSTEM.SETUP<39> +* +PORT=FIELD(ICONV('','U50BB'),' ',1) +READV USER FROM PT,PORT,1 ELSE USER='19999' +* +5 * +READU DUMMY FROM GEN.KEYS,"DUMMY.VAR" LOCKED + OTHER.PORT=STATUS() + READV OTHER.USER FROM PT,OTHER.PORT,1 ELSE OTHER.USER='19999' + READ CMREC FROM CM,OTHER.USER ELSE CMREC='unknown user' + OTHER.NAME=TRIM(CMREC<1>:" ":CMREC<2>) + CRT CS + CRT @(0,0):RV:" CMSD.PICKING PICKING SHEET PRINT PROCESSOR":SPACE(10):TIMEDATE():" ":ERV + CRT BEEP + CRT 'This program is currently being run by ':RV:OTHER.NAME:ERV:'. Only one instance may' + CRT 'run at any time. When the other user has finished, Press any key to continue:': + ANY='' ; INPUT ANY,1 ; IF ANY=PF3 THEN STOP ELSE GO 5 +END ELSE NULL +* +POS=0; MSG='' +MSG=MSG:@(POS,3):CR:"Enter " ; POS=POS+6 +MSG=MSG:@(POS,3):RV:"B":ERV:"atch, " ; POS=POS+7 +MSG=MSG:@(POS,3):RV:"A":ERV:"ll unprinted, " ; POS=POS+15 +MSG=MSG:@(POS,3):RV:"I":ERV:"ndividual, " ; POS=POS+12 +MSG=MSG:@(POS,3):RV:"F":ERV:"orce Item, " ; POS=POS+12 +MSG=MSG:@(POS,3):RV:"R":ERV:"eprint or " ; POS=POS+11 +MSG=MSG:@(POS,3):"Re":RV:"G":ERV:"enerate-->" +* +10 * +CRT CS +CRT @(0,0):RV:" CMSD.PICKING PICKING SHEET PRINT PROCESSOR":SPACE(10):TIMEDATE():" ":ERV: +CRT MSG: +ANSWER=''; INPUT ANSWER +IF CHECK.FILE.FLAG THEN + IF ANSWER="R" OR ANSWER="A" THEN GOSUB 3000 +END +IF ANSWER='' OR ANSWER='/' THEN STOP +11 * +IF ANSWER#'R' AND ANSWER#'G' AND ANSWER#'' AND ANSWER#'/' THEN + READU RUN.NUMBER FROM GEN.KEYS,"ORDER.RUN" ELSE + CRT 'ORDER.RUN not found in the GEN.KEYS file'; RQM; STOP + END + RUN.NUMBER=RUN.NUMBER+1 + WRITE RUN.NUMBER ON GEN.KEYS,"ORDER.RUN" + CURRENT.RUN=DATE():"*":RUN.NUMBER + REPRINT.FLAG=0 + FILENAME="SHIPPER.INDEX,":CURRENT.RUN + OPEN FILENAME TO SINDEX ELSE + EXECUTE "CREATE-FILE DATA ":FILENAME:" 17" CAPTURING JUNK + OPEN FILENAME TO SINDEX ELSE ABORT + END +END +* +15 * +BEGIN CASE + CASE ANSWER='B' + RUN='N' + CRT @(0,5):"Enter Batch Date to be printed-->": + BATCH.DATE=''; INPUT BATCH.DATE + BATCH.DATE=ICONV(BATCH.DATE,"D") + BDATE=OCONV(BATCH.DATE,"D2/") + READ XREF.REC FROM BATCH.XREF,BATCH.DATE ELSE + CRT @(0,22):"Invalid batch date was entered!!"; RQM; GO 10 + END + CRT @(0,7):"Enter Batch Number to be printed or 'ALL'-->": + BATCH.NUMBER=''; INPUT BATCH.NUMBER + IF BATCH.NUMBER="ALL" THEN + CRT @(0,9):"Selecting orders with items not printed for batch date: ":BDATE: + CRT + DATA \SSELECT PM.ORDERS WITH BATCH.DATE "\:BDATE:\" AND WITH BSTAT "C" BY ITEM BY ZIP.SORT\ + EXECUTE \SELECT PM.ORDERS.INDEX.RELEASED\ + END ELSE + BATCH.KEY=BATCH.DATE:"*":BATCH.NUMBER + READ BA.REC FROM BA,BATCH.KEY ELSE + CRT @(0,22):"Invalid batch number was entered!!"; RQM; GO 10 + END + CRT @(0,9):"Selecting orders with items not printed from batch: ":BDATE:"*":BATCH.NUMBER: + CRT + DATA \SSELECT PM.ORDERS WITH BATCH "\:BATCH.KEY:\" AND WITH BSTAT "C" BY ITEM BY ZIP.SORT \ + EXECUTE \SELECT PM.ORDERS.INDEX.RELEASED\ + END + CASE ANSWER='F' + CRT @(0,5):"Enter item number to be force shipped--->": + FORCE.ITEM=''; INPUT FORCE.ITEM + READ ANY FROM INVENTORY,FORCE.ITEM ELSE + CRT @(0,22):BEEP:"Invalid Item Entered! Press and try again...": + INPUT DUMMY + GO 15 + END + RUN='N' + CRT @(0,5):"Selecting Orders with items not printed - please wait....": + CRT + DATA \SSELECT PM.ORDERS WITH BSTAT "C" BY ITEM BY ZIP.SORT\ + EXECUTE \SELECT PM.ORDERS.INDEX.RELEASED\ + CASE ANSWER='A' + RUN='N' + CRT @(0,5):"Selecting Orders with items not printed - please wait....": + CRT + DATA \SSELECT PM.ORDERS WITH BSTAT "C" BY ITEM BY ZIP.SORT\ + EXECUTE \SELECT PM.ORDERS.INDEX.RELEASED\ + CASE ANSWER='I' + CRT @(0,5):CR:"Enter Order ## to be printed-->": + ORDER=''; INPUT ORDER + IF ORDER="" OR ORDER="/" THEN GO 10 + READ OREC FROM PMO,ORDER ELSE + CRT @(0,22):"Invalid Order ## entered"; RQM; GO 10 + END + OCT=DCOUNT(OREC,VM) + FOR O=1 TO OCT + CRT @(0,6+O):"ITEM: ":OREC:SPACE(5):"RUN: ":OREC + NEXT O + CRT @(0,7+O):"Enter Run ##'s for items to reprint, 'N' for new separated by commas": + CRT @(15,8+O):"Example: ":RV:"9050*3221,9055*3227,N":ERV:" -->": + RUN=''; INPUT RUN + EXECUTE \SELECT PM.ORDERS "\:ORDER:\"\ + CASE ANSWER='G' + CRT @(0,5):"Enter Run ## to be regenerated-->": + RUN=''; INPUT RUN + FILENAME="SHIPPER.INDEX,":RUN + OPEN FILENAME TO SINDEX ELSE + CRT @(0,22):"Invalid Run ## was entered"; RQM; GO 10 + END + CURRENT.RUN=RUN + REPRINT.FLAG=1 + DATA \SSELECT PM.ORDERS BY ITEM BY ZIP.SORT \ + EXECUTE \SELECT \:FILENAME + CASE ANSWER='R' + RUN='' ; ORDER='' ; REC.WRT=0 + CRT @(0,5):"Enter Run ## to be reprinted--> ": + INPUT RUN + CRT @(0,7):"Enter ORDER ## to be reprinted or (A)ll for entire run--> ": + INPUT ORDER + IF ORDER=PF1 OR ORDER=PF3 OR ORDER='' THEN GO 10 + * + CALL CMSD.PICKING.REPRINT(RUN,ORDER,REC.WRT) + * + IF REC.WRT GT 0 THEN CHAIN "CMSD.PICKING.PRT.CONTROL" + GO 10 + CASE 1 + GO 20 +END CASE +* +EOF=0; NUM.READ=0; NUM.DONE=0; NUM.PRINT=0 +LOOP + READNEXT ID ELSE EOF=1 +UNTIL EOF DO + GOSUB 1000 + IF REM(NUM.READ,10)=0 THEN GOSUB 2000 +REPEAT +GOSUB 2000 +CRT @(0,21):"Picking Slip Print Run ## ":RV:" ":CURRENT.RUN:" ":ERV:" is complete" +LOOP + CRT @(0,22):BEEP:"Note the Run Number above, then enter 'Y' to continue: ": + ANY=''; INPUT ANY +UNTIL ANY='Y' DO REPEAT +20 * +IF ANSWER='I' THEN GO 15 +999 * +SELECT SINDEX +READNEXT ID ELSE + * FILE IS EMPTY - DELETE IT + EXECUTE \DELETE-FILE DATA \:FILENAME CAPTURING JUNK +END +STOP +* +1000 *---qualify selected orders - build needed arrays for print routine +PREC=''; IREC=''; BO.ARRAY=''; REL.ARRAY=''; PRT.ARRAY='' +MISC.ARRAY=''; MPRT.ARRAY=''; TOTAL.ORDER=''; AUTH.ARRAY='' +RUN.ARRAY='' +READU IREC FROM PMO,ID ELSE GO 1100 +NUM.READ=NUM.READ+1 +IF ANSWER#'R' AND ANSWER#'G' THEN + IF IREC[1,1]#'A' AND IREC[1,1]#'C' THEN GO 1100 +END +LOCATE("RET",IREC,IVD$TRACK.ACTION;FNDIT) THEN + RET.ORD=1 +END ELSE + RET.ORD=0 +END +TERMS=IREC +BALANCE=IREC +READ PREC FROM PM,IREC ELSE + OPEN 'CHANGE.PARTNERS' TO CHANGE.PARTNERS THEN + READ CHG.REC FROM CHANGE.PARTNERS,IREC THEN + CHG.KEY=CHG.REC<1> + READ PREC FROM PM,CHG.KEY ELSE + CRT @(0,22):BEEP:"THERE IS A SERIOUS PROBLEM WITH ORDER##:":ID:" ": + ANY=''; INPUT ANY + GO 1100 + END + END + END +END +ICT=DCOUNT(IREC,VM) +FOR I=1 TO ICT + ITEM=IREC + QTY=IREC + GROSS=IREC + DISC=IREC + TAX=IREC + STAT=IREC + IAUTH=IREC + PRT=IREC + LN.NET.AMT=IREC + IF PRT # "" THEN + LOCATE(PRT,RUN.ARRAY,1;FNDRUN) ELSE + RUN.ARRAY=INSERT(RUN.ARRAY,1,FNDRUN;PRT) + END + END + * + IF TERMS="CC" AND STAT[1,1]="R" AND IAUTH="" AND LN.NET.AMT#0 THEN + ANY="" + CRT @(0,20):CR:BEEP:"Order number ":RV:" ":ID:" ":ERV:" is a credit card order and is in an ambiguous state." + CRT @(0,21):"Please write down the order number and give to the account manager .": + INPUT ANY + CRT @(0,20):CR + STAT="B" + END + * + BEGIN CASE + CASE STAT[1,1]='R' OR STAT[1,1]='G' OR STAT[1,1]='D' OR STAT[1,1]='F' + IF PRT="" THEN PRT="N" + OKAY=INDEX(RUN,PRT,1) + IF OKAY THEN + LOCATE(ITEM,REL.ARRAY,1;NDX;'AL') THEN NULL + REL.ARRAY=INSERT(REL.ARRAY,1,NDX;ITEM) + REL.ARRAY=INSERT(REL.ARRAY,2,NDX;QTY) + REL.ARRAY=INSERT(REL.ARRAY,3,NDX;GROSS) + REL.ARRAY=INSERT(REL.ARRAY,4,NDX;DISC) + REL.ARRAY=INSERT(REL.ARRAY,5,NDX;TAX) + REL.ARRAY=INSERT(REL.ARRAY,6,NDX;STAT) + IREC=CURRENT.RUN + IF IAUTH # "" AND IAUTH#'*' THEN + LOCATE(IAUTH,AUTH.ARRAY,1;WH;'AL') THEN + AUTH.ARRAY<2,WH>=AUTH.ARRAY<2,WH>+GROSS-DISC+TAX + END ELSE + AUTH.ARRAY=INSERT(AUTH.ARRAY,1,WH;IAUTH) + AUTH.ARRAY=INSERT(AUTH.ARRAY,2,WH;GROSS-DISC+TAX) + END + END + END ELSE + LOCATE(ITEM,PRT.ARRAY,1;NDX;'AL') THEN NULL + PRT.ARRAY=INSERT(PRT.ARRAY,1,NDX;ITEM) + PRT.ARRAY=INSERT(PRT.ARRAY,2,NDX;QTY) + PRT.ARRAY=INSERT(PRT.ARRAY,3,NDX;GROSS) + PRT.ARRAY=INSERT(PRT.ARRAY,4,NDX;DISC) + PRT.ARRAY=INSERT(PRT.ARRAY,5,NDX;TAX) + PRT.ARRAY=INSERT(PRT.ARRAY,6,NDX;STAT) + END + CASE STAT[1,1]='B' OR STAT[1,1]='C' + LOCATE(ITEM,BO.ARRAY,1;NDX;'AL') THEN NULL + BO.ARRAY=INSERT(BO.ARRAY,1,NDX;ITEM) + BO.ARRAY=INSERT(BO.ARRAY,2,NDX;QTY) + BO.ARRAY=INSERT(BO.ARRAY,3,NDX;GROSS) + BO.ARRAY=INSERT(BO.ARRAY,4,NDX;DISC) + BO.ARRAY=INSERT(BO.ARRAY,5,NDX;TAX) + BO.ARRAY=INSERT(BO.ARRAY,6,NDX;STAT) + END CASE +NEXT I +IF REL.ARRAY#'' THEN + MCT=DCOUNT(IREC,VM) + FOR M=1 TO MCT + MTYPE=IREC + MITEM=IREC + MAMOUNT=IREC + MPRT=IREC + MAUTH=IREC + IF MPRT="" THEN MPRT="N" + OKAY=INDEX(RUN,MPRT,1) + IF TERMS='CC' THEN + IF OKAY AND MAUTH#'' AND MAUTH#'*' THEN + LOCATE(MTYPE,MISC.ARRAY,1;NDX;'AL') THEN NULL + MISC.ARRAY=INSERT(MISC.ARRAY,1,NDX;MTYPE) + MISC.ARRAY=INSERT(MISC.ARRAY,2,NDX;MITEM) + MISC.ARRAY=INSERT(MISC.ARRAY,3,NDX;MAMOUNT) + IREC=CURRENT.RUN + LOCATE(MAUTH,AUTH.ARRAY,1;WH;'AL') THEN + AUTH.ARRAY<2,WH>=AUTH.ARRAY<2,WH>+MAMOUNT + END ELSE + AUTH.ARRAY=INSERT(AUTH.ARRAY,1,WH;MAUTH) + AUTH.ARRAY=INSERT(AUTH.ARRAY,2,WH;MAMOUNT) + END + END ELSE + LOCATE(MTYPE,MPRT.ARRAY,1;NDX;'AL') THEN NULL + MPRT.ARRAY=INSERT(MPRT.ARRAY,1,NDX;MTYPE) + MPRT.ARRAY=INSERT(MPRT.ARRAY,2,NDX;MITEM) + MPRT.ARRAY=INSERT(MPRT.ARRAY,3,NDX;MAMOUNT) + END + END ELSE + IF OKAY THEN + LOCATE(MTYPE,MISC.ARRAY,1;NDX;'AL') THEN NULL + MISC.ARRAY=INSERT(MISC.ARRAY,1,NDX;MTYPE) + MISC.ARRAY=INSERT(MISC.ARRAY,2,NDX;MITEM) + MISC.ARRAY=INSERT(MISC.ARRAY,3,NDX;MAMOUNT) + IREC=CURRENT.RUN + END ELSE + LOCATE(MTYPE,MPRT.ARRAY,1;NDX;'AL') THEN NULL + MPRT.ARRAY=INSERT(MPRT.ARRAY,1,NDX;MTYPE) + MPRT.ARRAY=INSERT(MPRT.ARRAY,2,NDX;MITEM) + MPRT.ARRAY=INSERT(MPRT.ARRAY,3,NDX;MAMOUNT) + END + END + NEXT M +END +IF REL.ARRAY#'' THEN + NOT.PRINTED=0 + BEGIN CASE + CASE ANSWER='A' + RUN.CT=DCOUNT(RUN.ARRAY<1>,VM) + IF BO.ARRAY#'' AND RUN.CT+1 GE MAX.SHIPMENTS THEN + NOT.PRINTED=1 + END ELSE + IF RET.ORD ELSE ;*returns + CALL CMSD.PICKING.SUB.BUILD(PREC,IREC,BO.ARRAY,REL.ARRAY,PRT.ARRAY,MISC.ARRAY,MPRT.ARRAY,TOTAL.ORDER,AUTH.ARRAY,CURRENT.RUN,REPRINT.FLAG) + END + END + CASE ANSWER="F" + LOCATE(FORCE.ITEM,REL.ARRAY,1;FNDIT) THEN + IF RET.ORD ELSE ;*returns + CALL CMSD.PICKING.SUB.BUILD(PREC,IREC,BO.ARRAY,REL.ARRAY,PRT.ARRAY,MISC.ARRAY,MPRT.ARRAY,TOTAL.ORDER,AUTH.ARRAY,CURRENT.RUN,REPRINT.FLAG) + END + END ELSE + NOT.PRINTED=1 + END + CASE 1 + IF RET.ORD ELSE ;*returns + CALL CMSD.PICKING.SUB.BUILD(PREC,IREC,BO.ARRAY,REL.ARRAY,PRT.ARRAY,MISC.ARRAY,MPRT.ARRAY,TOTAL.ORDER,AUTH.ARRAY,CURRENT.RUN,REPRINT.FLAG) + END + END CASE + IF NOT.PRINTED ELSE + IF ANSWER#'R' AND ANSWER#'G' THEN + IREC=INSERT(IREC,IVD$TRACK.ACTION,1;"PRT") + IREC=INSERT(IREC,IVD$TRACK.OPERATOR,1;USER) + IREC=INSERT(IREC,IVD$TRACK.DATE,1;DATE()) + IREC=INSERT(IREC,IVD$TRACK.TIME,1;TIME()) + WRITE IREC ON PMO,ID + IF IREC="COD" THEN + WRITE TOTAL.ORDER ON SINDEX,ID + END ELSE + WRITE "" ON SINDEX,ID + END + NUM.PRINT=NUM.PRINT+1 + END + END +END +NUM.DONE=NUM.DONE+1 +1100 * +RELEASE PMO,ID +RETURN +* +2000 *---refresh total display--- +CRT @(0,15):CR +CRT @(0,15):'NUMBER RECORDS READ: ':NUM.READ +CRT @(0,16):'NUMBER RECORDS PROCESSED: ':NUM.DONE +CRT @(0,17):'NUMBER RECORDS SELECTED: ':NUM.PRINT +RETURN +* +3000 *-check PM.LABELS file for records--* +CHECK.FILE.FLAG=0 ; EOF=0 +SELECT PM.LABELS +* +LOOP + READNEXT ID ELSE EOF=1 +UNTIL EOF DO + 3100 * + CRT @(0,20):CR:BEEP:"The PM.LABELS file has data in it, would you like to continue(Y/N) : ": + INPUT ANS + IF ANS[1,1]="Y" THEN GO 3200 + IF ANS[1,1]="N" THEN STOP + IF ANS[1,1]="N" OR ANS[1,1]="Y" ELSE GO 3100 +REPEAT +3200 * +RETURN +*