|
Darryl Freinkel
A4G
Telephone: 770.321.8562 Mobile: 678.355.8562
c* ---------------------------------------------------
c* Proc_Add - add additional requirements for FOR STOCK or Screws
c* ---------------------------------------------------
c Proc_Add begsr
c | clear ivudshw5
c* eval wFinish = dFinish
c* eval wPart = dPart
c* eval wDesc = ddesc
c* eval wQtyReqd = dqtyr
c* eval WQOH = donhand
c* eval wQTOO = dToOrder
c* eval wNewQTO = dToOrder
c | doU *inKF or *inKL
F6 or F12
c | | write msgctl
error messages
c | | exfmt ivudshw5
c | | exsr $CLRMS
c | | select
c | | when *inKC
F3
c | | | leavesr
c | | when *inKL
F12
c | | | eval wRRN1 += 1
c | | | iter
| | | // Write to files if valid
c | | when *inKF and not wErrors
F6
c | | | exsr proc_addValid
c | | | if wErrors
c | | | | eval *inKF = *off
c* iter
c | | | else
c | | | | if wReq_Type = 'FOR STOCK'
c | | | | | eval wRcd_type = 'S'
c | | | | elseif wReq_Type = 'SCREWS'
c | | | | | eval wRcd_Type = 'T'
c | | | | else
c | | | | | eval wRcd_Type = ' '
c | | | | endif
| | | | chain ( wSched_DATE : wRcd_Type
:wFinish :
| | | | wPart) IVSUML05;
c | | | | if not %found(ivsuml05)
c | | | | | clear ivsumf05
c | | | | | eval sudate = wSched_Date
c | | | | | eval sufnop = fnfnop
c | | | | | eval sufnds = wFinish
c | | | | | eval supart = wPart
c | | | | | eval supdsc = wDesc
c | | | | | eval sustat = '1'
c | | | | | eval sutype = wRcd_Type
c | | | | | eval suptyp = 'P'
c | | | | | eval suqtyr = wQtyReqd
c | | | | | eval suqoh = wQOH
c | | | | | eval suqtyo = wQTOO
c | | | | | write ivsumf05
c | | | | Endif
c* update low level quantities
| | | | // FOR STOCK records
c | | | | if wReq_Type = 'FOR STOCK'
c wPart | | | | | chain mfbomp
c | | | | | DoW %found(MFBOMP) and not
%eof(MFBOMP)
c | | | | | | if mbend <> *blanks
c wPart | | | | | | | reade mfbomp
c | | | | | | Endif
c | | | | | | clear ivreqf
c | | | | | | eval ivshdt = wSched_Date
c | | | | | | eval ivlnqt = wQtyReqd
c | | | | | | eval ivmpt# = wPart
c | | | | | | eval ivdesc = wDesc
c | | | | | | eval ivfnOP = FNFNOP
c | | | | | | eval ivfnds = wFinish
c | | | | | | eval ivbth = 'C'
c | | | | | | eval ivprnt = wPart
c | | | | | | eval ivprnq = wQtyReqd
c | | | | | | eval ivuplt = mbcomp
c | | | | | | eval ivuplq = wQTOO *
mbQtyP
c | | | | | | write ivreqf
c wPart | | | | | | reade mfbomp
c | | | | | Enddo
c | | | | Endif
| | | | // Add SCREW requirement
c | | | | if wReq_Type = 'SCREWS'
c | | | | | clear ivreqf
c | | | | | eval ivshdt = wSched_Date
c | | | | | eval ivlnqt = wQtyReqd
c | | | | | eval ivmpt# = wPart
c | | | | | eval ivdesc = wDesc
c | | | | | eval ivfnOP = FNFNOP
c | | | | | eval ivfnds = wFinish
c | | | | | eval ivbth = 'P'
c | | | | | eval ivprnt = wPart
c | | | | | eval ivprnq = wQtyReqd
c | | | | | eval ivuplt = mbcomp
c | | | | | eval ivuplq = wQTOO * mbQtyP
c | | | | | write ivreqf
c | | | | endif
c | | | Endif
c | | other
c | | | exsr proc_addValid
c | | Endsl
c | Enddo
c Endsr
c* ---------------------------------------------------
c* proc_addValid - Validate screen when adding lines to the schedule.
c* ---------------------------------------------------
c proc_addValid Begsr
| // Validations
c | eval wErrors = *off
c | eval *in41 = *off
c | eval *in42 = *off
c | eval *in43 = *off
c | eval *in44 = *off
c | eval *in45 = *off
c | eval *in46 = *off
| // Check FOR STOCK or SCREWS
| // Using SQL to convert to upper case
| exec sql values upper(:wReq_Type) into
:wReq_Type ;
c | if wReq_Type <> 'FOR STOCK' and
c | | wReq_Type <> 'SCREWS'
c | | eval wErrors = *on
c | | eval *in41 = *on
C | | MOVE 'PL00017' MSGFLD
C | | eval msgdta = *blanks
C | | EXSR $SNDMS
c | Endif
| // Finish
c wFinish | chain oefshl04
c | if not %found(oefshl04)
c | | eval wErrors = *on
c | | eval *in42 = *on
C | | MOVE 'PL00018' MSGFLD
C | | eval msgdta = *blanks
C | | EXSR $SNDMS
C | else
C | | if fnbth <> 'P'
c | | | eval wErrors = *on
c | | | eval *in41 = *on
C | | | MOVE 'PL00019' MSGFLD
C | | | eval msgdta = *blanks
C | | | EXSR $SNDMS
c | | Endif
c | Endif
| // Part Number
c* eval wPart = dPart
c | clear wPart_save
c | if wPart = *blanks
c | | eval wErrors = *on
c | | eval *in43 = *on
c | | eval wDesc = *all'*'
C | | MOVE 'PL00008' MSGFLD
C | | eval msgdta = *blanks
C | | EXSR $SNDMS
c | else
c | | exsr getPartDesc
c | | if %found(TLCSTP)
c | | | eval wDesc = ddesc
c | | else
c | | | eval wErrors = *on
c | | | eval *in43 = *on
c | | | eval wDesc = *all'*'
C | | | MOVE 'PL00008' MSGFLD
C | | | eval msgdta = *blanks
C | | | EXSR $SNDMS
c | | Endif
c | Endif
| // Qty > 0
c | if wQtyReqd <= 0
c | | eval wErrors = *on
c | | eval *in44 = *on
C | | MOVE 'PL00003' MSGFLD
C | | eval msgdta = *blanks
C | | EXSR $SNDMS
c | Endif
c | if wQOH < 0
c | | eval wErrors = *on
c | | eval *in45 = *on
C | | MOVE 'PL00015' MSGFLD
C | | eval msgdta = *blanks
C | | EXSR $SNDMS
c | Endif
c | if wQTOO <= 0
c | | eval wErrors = *on
c | | eval *in46 = *on
C | | MOVE 'PL00005' MSGFLD
C | | eval msgdta = *blanks
C | | EXSR $SNDMS
c | Endif
| // does it have a BOM
c wPart | chain mfbomp
c | if not %found(mfbomp)
c | | eval wErrors = *on
C | | MOVE 'PL00016' MSGFLD
C | | eval msgdta = *blanks
C | | EXSR $SNDMS
c | Endif
| // does an entry for this already exist
| chain ( wSched_DATE : wFinish : wPart)
IVSUML01;
c | if %found(IVSUML01)
c | | eval wErrors = *on
C | | MOVE 'PL00020' MSGFLD
C | | eval msgdta = *blanks
C | | EXSR $SNDMS
c | Endif
c Endsr
c* ---------------------------------------------------
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.
midrange.com
