Re: Trying to setof *INKF

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* ---------------------------------------------------