FIND mode not working
Syed Shahul Hameed Mustaffa
sshahulgm at gmail.com
Sat Jul 23 11:25:42 CDT 2005
Dear everyone,
I have attached the file again with my code changes.
The modifications are as JOE, REELYand RICHARD suggested.(pls. forgive
if i have missed anyone)
1. I have made SW-TYPE, TCOMPUTER & T-WORK to RESET AT STARTUP
2. I moved the GETPARAMS to the PATH (which I tried myself earlier
without RESET AT STARTUP).
So with this changes, it seems, I've got all the functionality of the
original screen.
I still have one more thing to solve. When I click the UPDATE button,
I'm getting a message box with 'Data has been changed but not updated'
and OK, Cancel buttons. If I click the OK button however it saves the
data.
Does anyone of you know how to stop this or why it is poping up? Do
you need the table structures?
I'm so excited that this problem has solved. Because now I hope that I
can go merry round the other programs and start to make things work.
Thanks to everyone of you gentlemen for your time, sincere and
professional help.
Best Regards,
SYED.
On 7/22/05, Joe Boyle <atla38 at dsl.pipex.com> wrote:
> Hi Syed,
>
> I'm not claiming that any of the suggestions I make will solve the problem,
> I am only offering them as possible points to look at in the hope that they
> might lead the way to a solution.
>
> I find it odd that there is an edit verb to a field which has neither an
> edit procedure nor a process procedure; which might suggest that you remove
> it altogether or that all of the procedures in the screen source file aren't
> present in the attachment that you sent to the list.
>
> Regards, Joe.
>
>
> -----Original Message-----
> From: powerh-l-bounces+atla38=dsl.pipex.com at lists.sowder.com
> [mailto:powerh-l-bounces+atla38=dsl.pipex.com at lists.sowder.com] On Behalf Of
> Syed Shahul Hameed Mustaffa
> Sent: 22 July 2005 14:40
> To: Joe Boyle
> Cc: powerh-l at lists.sowder.com
> Subject: Re: FIND mode not working
>
> Dear Bob,
>
> I'll ask your MPEIX questions tomorrow to the PH programmer.
>
> Dear Joe,
>
> If the error could be in the DUMMY1 field, the code shouldn't show any
> improvement even when I moved it to the PATH procedure.
> I'll try setting T-WORK, T-SAFI and TCOMPUTER
> to reset at startup/mode.
>
> Best Regards,
> SYED.
>
>
>
> On 7/22/05, Joe Boyle <atla38 at dsl.pipex.com> wrote:
> > Just one more thought, what happens if you make T-WORK, T-SAFI and
> TCOMPUTER
> > all reset at startup/mode.
> >
> > Regards, Joe.
> >
> > -----Original Message-----
> > From: powerh-l-bounces+atla38=dsl.pipex.com at lists.sowder.com
> > [mailto:powerh-l-bounces+atla38=dsl.pipex.com at lists.sowder.com] On Behalf
> Of
> > Syed Shahul Hameed Mustaffa
> > Sent: 21 July 2005 22:44
> > To: Deskin, Bob
> > Cc: powerh-l at lists.sowder.com
> > Subject: Re: FIND mode not working
> >
> > Dear Bob,
> >
> > I believe I tried this dummy PATH procedure and it didn't seem to work
> > (I'll try again). You may be right about REQUEST verbs not setting
> > thing in request buffer. Because, the cursor does not prompt at the
> > REQUEST fields as long as there is no PATH procedure or even with a
> > dummy PATH procedure. However, when I moved the internal procedure
> > GETPARAMS to the PATH procedure, the cursor prompts at the REQUEST
> > fields when i choose FIND mode.
> >
> > Regards,
> > SYED.
> >
> >
> >
> > On 7/21/05, Deskin, Bob <Bob.Deskin at cognos.com> wrote:
> > > Did this code work on MPE/iX as is (with the INTERNAL procedure in the
> > FIND)? This will generate a default PATH procedure but there won't be any
> > prompting because of the ACCESS statement on the PRIMARY. I still don't
> > understand why you need the internal procedure in the FIND and not in the
> > PATH.
> > >
> > > Of the top I don't know why it won't work. It may be that the REQUEST
> > verbs aren't setting things in the request buffer unless they're in the
> PATH
> > procedure. I suggest coding a dummy PATH procedure that says:
> > >
> > > PROCEDURE PATH
> > > LET PATH = 1
> > >
> > > just to override the default. Not sure if it will help, but it won't
> hurt.
> > >
> > > I would also suggest (as I believe someone suggested before) that you
> add
> > RESET AT STARTUP to your temps that are used in retrieval. These may get
> > reset for every retrieval cycle.
> > >
> > > Bob
> > >
> > >
> > > -----Original Message-----
> > > From: Syed Shahul Hameed Mustaffa [mailto:sshahulgm at gmail.com]
> > > Sent: July 21, 2005 10:35 AM
> > > To: Deskin, Bob
> > > Cc: powerh-l at lists.sowder.com
> > > Subject: Re: FIND mode not working
> > >
> > >
> > > Dear Bob,
> > >
> > > I'm working on AXIANT 4GL.
> > > I've attached the code file.
> > > This is the original MPE/IX code.
> > >
> > > Some explanation.
> > > SW-TYPE can be S or W.
> > > IF I enter S for SW-TYPE, then the screen should accept a value for
> > > field T-SAFI.
> > > IF I enter W for SW-TYPE, then the screen should accept a value for
> > > field T-WORK.
> > > IF I enter the value for T-SAFI, CHECK-SAFI internal procedure finds
> > > the value for T-WORK and TCOMPUTER thru the internal procedure
> > > If I enter the value for T-WORK, CHECK-WORK internal procedure finds
> > > the value for T-SAFI and TCOMPUTER.
> > >
> > > As it is this code does not work in AXIANT.
> > > I had to move the 'DO GETPARMS' procedure to the PATH procedure to
> > > make the screen accept the SELECT MODE. The rest I have explained
> > > already in my earlier mail.
> > >
> > > Thank you.
> > > Syed
> > >
> > > On 7/21/05, Deskin, Bob <Bob.Deskin at cognos.com> wrote:
> > > > I've come into this late so if something here has already been
> > mentioned, my apologies.
> > > >
> > > > Your code would help because we don't know what you've done with the
> > PATH procedure.
> > > >
> > > > By default, QDESIGN generates a PATH procedure to request index
> segment
> > values and a FIND procedure to do the retrieval based on the values
> entered.
> > If you look at a default PATH procedure you'll see that based on the
> entered
> > values, the PATH item is set. PATH is then used to determine which of many
> > possible retrieval methods is used in the FIND procedure.
> > > >
> > > > In Select mode, there is an additional step between the PATH and FIND
> > procedures where QUICK prompts for selection values. There is an optional
> > SELECT procedure that you can code but it's normally not needed.
> > > >
> > > > When you enter F or S in the action field, QUICK executes the PATH
> > procedure (and does selection if you entered S) and if the PATH procedure
> is
> > successful, continues on to the FIND procedure to retrieve data. If the
> PATH
> > procedure issues an error, things stop there.
> > > >
> > > > Putting REQUEST verbs in the FIND procedure is actually too late. The
> > REQUEST verb is special in that it prompts for the data in the field
> buffer
> > but also puts the value in a special request buffer to be used for the
> > retrieval. This is because it is possible to change the values originally
> > prompted for. So a save area is needed for subsequent retrieval.
> > > >
> > > > The way QUICK is designed to work is to establish your retrieval path
> in
> > the PATH procedure and the do the retrieval in the FIND procedure.
> > > >
> > > > By the way, have you used the QUICK debug trace to see what's
> happening
> > with the data you've entered.
> > > >
> > > > Regards
> > > >
> > > > Bob
> > > >
> > > > -----Original Message-----
> > > > From: powerh-l-bounces+bob.deskin=cognos.com at lists.sowder.com
> > > > [mailto:powerh-l-bounces+bob.deskin=cognos.com at lists.sowder.com]On
> > > > Behalf Of Syed Shahul Hameed Mustaffa
> > > > Sent: July 21, 2005 4:48 AM
> > > > To: Joe Boyle
> > > > Cc: powerh-l at lists.sowder.com
> > > > Subject: Re: FIND mode not working
> > > >
> > > >
> > > > Dear Joe,
> > > >
> > > > I cannot remove the existing FIND procedure. There are application
> > > > logic built into it.
> > > > I am explaining the scenario in a better fashion underneath. I'm
> > > > trying as much not to confuse. If u still require the code (which is
> > > > simple), I'll post it.
> > > >
> > > > In the original code, the FIND procedure calls an internal procedure
> > > > called GETPARAMS.
> > > > This procedure contains the REQUEST statements. Based on what I enter
> > > > on the REQUEST fields, a temporary variable called TCOMPUTER is set to
> > > > a value.
> > > >
> > > > With this code, when i execute the screen and try to select FIND mode,
> > > > it does not work. However when, I moved the GETPARAMS procedure to the
> > > > PATH procedure, I can get the screen in select mode. I can enter the
> > > > parameters and everything seems to be ok. But the problem starts when
> > > > I hit the ENTER Key to initiate the data retrieval. The TCOMPUTER
> > > > value set by the PATH procedure gets lost (reset to 0) when the
> > > > control reaches the FIND procedure. In the find procedure, I have a
> > > > GET statement that uses this TCOMPUTER to search for records. I tried
> > > > hardcoding the TCOMPUTER value that I lose on the transit, and the
> > > > search works fine. I searced in vain for any intermediate code that
> > > > resets the value of TCOMPUTER.
> > > >
> > > > Pls. give me some insight about what happens between PATH and FIND
> > > > procedure calls.
> > > >
> > > > Thankyou somuch.
> > > > Syed
> > > >
> > > >
> > > > On 7/20/05, Joe Boyle <atla38 at dsl.pipex.com> wrote:
> > > > > Hi Syed,
> > > > >
> > > > > You don't give any details of the access syntax you have coded
> against
> > the
> > > > > table so it is difficult to suggest much.
> > > > >
> > > > > Try clicking on the path icon to create one; incidentally why do you
> > think
> > > > > that there isn't one and have you coded your own find procedure ?
> > > > >
> > > > > As for the 'list detail' equivalent, you have to turn (or it is
> easier
> > if
> > > > > you turn on) 'keep temp files' in the build profile. You then add
> > syntax
> > > > > like ' set list sql list transaction detail procedures' into the set
> > > > > statement of the screens identity tab. You then commit the
> repository
> > and
> > > > > then recompile the screen. I believe that the procedural code will
> > then be
> > > > > found in the .qkr file in the build location.
> > > > >
> > > > > Regards, Joe.
> > > > >
> > > > >
> > > > > -----Original Message-----
> > > > > From: powerh-l-bounces+atla38=dsl.pipex.com at lists.sowder.com
> > > > > [mailto:powerh-l-bounces+atla38=dsl.pipex.com at lists.sowder.com] On
> > Behalf Of
> > > > > Syed Shahul Hameed Mustaffa
> > > > > Sent: 20 July 2005 15:37
> > > > > To: Joe Boyle
> > > > > Cc: powerh-l at lists.sowder.com
> > > > > Subject: FIND mode not working
> > > > >
> > > > > Dear Joe,
> > > > >
> > > > > In a screen I have a FIND procedure. However the FIND mode is not
> > working.
> > > > > I found that there is no PATH procedure. Have you encountered such a
> > > > > scenario?
> > > > >
> > > > > Dear Gurus,
> > > > >
> > > > > If there is anyone who has encountered this scenario, pls help.
> > > > >
> > > > > Regards,
> > > > > SYED.
> > > > >
> > > > > --
> > > > > = = = = = = = = = = = = = = = = = = = = = = = = = = = =
> > > > > Mailing list: powerh-l at lists.sowder.com
> > > > > Subscribe: "subscribe" in message body to
> > powerh-l-request at lists.sowder.com
> > > > > Unsubscribe: "unsubscribe <password>" in message body to
> > > > > powerh-l-request at lists.sowder.com
> > > > > http://lists.sowder.com/mailman/listinfo/powerh-l
> > > > > This list is closed, thus to post to the list you must be a
> > subscriber.
> > > > >
> > > > >
> > > >
> > > > --
> > > > = = = = = = = = = = = = = = = = = = = = = = = = = = = =
> > > > Mailing list: powerh-l at lists.sowder.com
> > > > Subscribe: "subscribe" in message body to
> > powerh-l-request at lists.sowder.com
> > > > Unsubscribe: "unsubscribe <password>" in message body to
> > powerh-l-request at lists.sowder.com
> > > > http://lists.sowder.com/mailman/listinfo/powerh-l
> > > > This list is closed, thus to post to the list you must be a
> subscriber.
> > > >
> > > > This message may contain privileged and/or confidential
> > information. If you have received this e-mail in error or are not the
> > intended recipient, you may not use, copy, disseminate or distribute it;
> do
> > not open any attachments, delete it immediately from your system and
> notify
> > the sender promptly by e-mail that you have done so. Thank you.
> > > >
> > > >
> > > >
> > >
> >
> > --
> > = = = = = = = = = = = = = = = = = = = = = = = = = = = =
> > Mailing list: powerh-l at lists.sowder.com
> > Subscribe: "subscribe" in message body to
> powerh-l-request at lists.sowder.com
> > Unsubscribe: "unsubscribe <password>" in message body to
> > powerh-l-request at lists.sowder.com
> > http://lists.sowder.com/mailman/listinfo/powerh-l
> > This list is closed, thus to post to the list you must be a subscriber.
> >
> >
>
> --
> = = = = = = = = = = = = = = = = = = = = = = = = = = = =
> Mailing list: powerh-l at lists.sowder.com
> Subscribe: "subscribe" in message body to powerh-l-request at lists.sowder.com
> Unsubscribe: "unsubscribe <password>" in message body to
> powerh-l-request at lists.sowder.com
> http://lists.sowder.com/mailman/listinfo/powerh-l
> This list is closed, thus to post to the list you must be a subscriber.
>
>
-------------- next part --------------
screen CWQK430N receiving OCODE,U-PASS
temp OCODE char*2
temp PNAME char*8 initial "CWQK430N"
use CMSECFIL.PHTECH nol nod
use CMHDTMPM.PHTECH nol nod
use UNACTEMP.PHTECH nol nod
use UNACFILE.PHTECH nol nod
;*************************************************************
;Program was modified to default SYSDATE as transaction date
;on ENTRY.
; 16/4/92 - For the HELP subscreen on DEATH REASONS, the
; program now calls CWQK975N in place of CWQK974N --
; this new subscreen shows ONLY reasons for death,
; without cull reasons which are excluded by a
; select matchpattern.
;*************************************************************
file PARA-M in cwdb reference
access via UNIT-NO using 0000
;mig temp TCOMPUTER zoned size 6
temp TCOMPUTER zoned size 6 RESET AT STARTUP
;mig temp SW-TYPE char size 1
temp SW-TYPE char size 1 RESET AT STARTUP
;mig temp T-WORK zoned size 6
temp T-WORK zoned size 6 RESET
define T-UNIT-WORK zoned size 10=&
nconvert(ascii(T-UNIT,4)+ascii(T-WORK,6))
;mig temp T-SAFI zoned size 6
temp T-SAFI zoned size 6 RESET AT STARTUP
temp T-STAR char size 1
temp T-EDM char size 3
temp T-BBM char size 3
temp EVAL char size 6
temp REAS char size 4
temp BCS-FLAG
temp T-UNIT-YARD zoned size 8
;temp T-DEATH-DATE date initial sysdate
file COW-LOC-D in cwdb reference alias COW-LOC-D-A1
access via CLD-UNIT-WORK-NO using T-UNIT-WORK
file COW-LOC-D in cwdb reference alias COW-LOC-D-A2
access via CLD-SAADCO-NO using T-SAFI
;define T-UY-NO zoned size 8 = &
; CLD-UNIT-YARD-NO of COW-LOC-D-A1 &
; if SW-TYPE = "W" &
; else CLD-UNIT-YARD-NO of COW-LOC-D-A2 &
; if SW-TYPE = "S"
file DEATH-D in cwdb primary
access via COMPUTER-NO using TCOMPUTER
file COW-D in cwdb secondary noitems
access via CLD-COMPUTER-NO using TCOMPUTER
file EVAL-M in cwdb reference noitems
access via EVAL-ID using EVAL-ID of EVAL-M
;mig file REASON-M reference noitems
;mig access via REAS-CD using REAS-CD of DEATH-D
;-------------- MIG CODE BEGINS -----------------
file REASON-M in cwdb reference alias REASON-M1 noitems
access via REAS-CD using REAS-CD1 of DEATH-D
file REASON-M in cwdb reference alias REASON-M2 noitems
access via REAS-CD using REAS-CD2 of DEATH-D
file REASON-M in cwdb reference alias REASON-M3 noitems
access via REAS-CD using REAS-CD3 of DEATH-D
;-------------- MIG CODE ENDS -----------------
file BREED-SUMM-D in cwdb designer noitems
access via CLD-COMPUTER-NO using TCOMPUTER
select if BS-END-DATE eq 0
file LACT-SUMM-D in cwdb designer noitems
access via CLD-COMPUTER-NO using TCOMPUTER
select if LS-LACT-EDATE eq 0
file YARD-D in cwdb designer
access via CLD-UNIT-YARD-NO using T-UNIT-YARD
file ALPRO-UPDATE-D in cwdb designer
;access via COMPUTER-NO using TCOMPUTER
use CMHDLYTM.PHTECH nol nod
draw thin from 5,1 to 23,79
draw thin from 8,1 to 8,79
draw thin from 16,1 to 16,79
hilite DATA underline, EDIT audible inverse
skip to 6
align (2,5,12) (,,17) (38,41,48) (,50,55) (,62,67) (,,74) (,,76)
field DUMMY1 silent
field T-UNIT nochange nocorrect label "Unit : " ID 1 &
lookup on UNIT-M via UNIT-NO using T-UNIT message 1, &
on PARA-M via UNIT-NO using 0000 message 19
field UNIT-NAME of UNIT-M display
field SW-TYPE nocorrect nochange upshift value "S", "W" default "W" &
help "Enter S ---> for SAADCO# or W ---> for WORK#" label "S/W : "
field T-WORK required nochange if SW-TYPE = "W" lookup on COW-LOC-D-A1&
via CLD-UNIT-WORK-NO using T-UNIT-WORK message 4 label "W# : " &
help "Enter animal's Work# between 1 to 999998" VALUES 1 TO 999998
field T-SAFI required nochange if SW-TYPE = "S" lookup on COW-LOC-D-A2&
via CLD-SAADCO-NO using T-SAFI message 3 label "S# : " &
help "Enter animal's Safi# between 1 to 999998" VALUES 1 TO 999998
field TCOMPUTER silent &
lookup on COW-D via CLD-COMPUTER-NO using TCOMPUTER message 14,&
noton DEATH-D via COMPUTER-NO using TCOMPUTER message 401
hilite DATA off
hilite DISPLAY blinking
field T-STAR display
hilite DISPLAY off
hilite DATA underline,EDIT audible inverse
field CULL-IND of COW-D display
skip
align (2,5,12) (24,27,34) (,,72) (,,76)
field DEATH-DATE label "Date : " predisplay &
default sysdate format DDMMYYYY
field DEATH-TIME of DEATH-D label "Time : " nochange default&
nconvert(ascii(systime,8)[1:4]) predisplay
hilite DATA off
hilite DISPLAY blinking
field T-BBM display
field T-EDM display
hilite DISPLAY off
hilite DATA underline,EDIT audible inverse
skip to 9
title "Death Reasons : " at 11,5
align (,,24) (,,32)
;mig cluster occurs with REAS-CD of DEATH-D ID 6 at ,2
;mig
;mig field REAS-CD of DEATH-D nolabel noid lookup on REASON-M &
;mig via REAS-CD using REAS-CD of DEATH-D message 9
;mig field REAS-DESC of REASON-M display
;mig
;mig align (2,5,24)
;mig cluster
;--------------------- MIG CODE BEGINS -------------------------
field REAS-CD1 of DEATH-D nolabel ID SAME lookup on REASON-M1 &
via REAS-CD using REAS-CD1 of DEATH-D message 9
field REAS-DESC of REASON-M1 display
field REAS-CD2 of DEATH-D nolabel ID SAME lookup on REASON-M2 &
via REAS-CD using REAS-CD2 of DEATH-D message 9
field REAS-DESC of REASON-M2 display
field REAS-CD3 of DEATH-D nolabel ID SAME lookup on REASON-M3 &
via REAS-CD using REAS-CD3 of DEATH-D message 9
field REAS-DESC of REASON-M3 display
;--------------------- MIG CODE ENDS -------------------------
align (2,5,24)
skip
field COMMENTS of DEATH-D label "Comments : "
skip 2
align (2,5,24) (,,32)
field EVAL-ID of DEATH-D label "Vet# : " lookup on &
EVAL-M via EVAL-ID using EVAL-ID of DEATH-D opt
field EVAL-NAME of EVAL-M display
skip
align (2,5,24) (36,39,50) (60,63,69)
field VET-EXAM-DATE of DEATH-D label "Exam Date : " &
format DDMMYYYY
field VET-EXAM-TIME of DEATH-D label "Time : "
field BCS of DEATH-D label "BCS : "
skip
align (2,5,24) (36,39,50)
field VET-AUT-REP-NO of DEATH-D label "Autopsy Report # : "
field VET-COMMENTS of DEATh-D label "Comments : "
use CMHDPRCL.PHTECH nol nod
use UNACPROC.PHTECH nol nod
procedure edit DEATH-DATE
begin
if fieldvalue ne sysdate
then error "Death Date should be equal to the current date."
if fieldvalue lt PARA-PRC-PRD-FRM or &
fieldvalue gt PARA-PRC-PRD-TO
then error 101
if fieldvalue gt sysdate
then error 100
end
procedure process DEATH-TIME of DEATH-D
begin
;let DEATH-DATE of DEATH-D = T-DEATH-DATE
let VET-EXAM-DATE of DEATH-D = DEATH-DATE of DEATH-D
let DEATH-TRF-DATE of ALPRO-UPDATE-D = DEATH-DATE of DEATH-D
display VET-EXAM-DATE of DEATH-D
end
procedure internal CHECK-WORK
begin
get COW-LOC-D-A1 via CLD-UNIT-WORK-NO using T-UNIT-WORK optional
if not accessok
then error 4
let TCOMPUTER = CLD-COMPUTER-NO of COW-LOC-D-A1
let T-SAFI = CLD-SAADCO-NO of COW-LOC-D-A1
display T-SAFI
let T-UNIT-YARD = CLD-UNIT-YARD-NO of COW-LOC-D-A1
end
procedure process T-WORK
begin
do internal CHECK-WORK
end
procedure internal CHECK-SAFI
begin
get COW-LOC-D-A2 via CLD-SAADCO-NO using T-SAFI optional
if not accessok
then error 3
if T-UNIT NE UNIT-NO of COW-LOC-D-A2
then error 102
let TCOMPUTER = CLD-COMPUTER-NO of COW-LOC-D-A2
let T-WORK = CLD-WORK-R of COW-LOC-D-A2
infor = "Unit-no " + ascii(t-unit)
display T-WORK
let T-UNIT-YARD = CLD-UNIT-YARD-NO of COW-LOC-D-A2
end
procedure process T-SAFI
begin
do internal CHECK-SAFI
end
procedure internal CHECK-RTN
begin
if CM-ABORTION-IND of COW-D eq "Y"
then let T-STAR = "*"
else let T-STAR = " "
display T-STAR
if CM-EDM of COW-D eq "Y"
then let T-EDM = "EDM"
else let T-EDM = " "
display T-EDM
if CM-BBM of COW-D eq "Y"
then let T-BBM = "BBM"
else let T-BBM = " "
display T-BBM
if CM-DEAD-SOLD-IND of COW-D = "D"
then error 401
if CM-DEAD-SOLD-IND of COW-D = "S"
then error 402
; if CM-HERD-TYPE of COW-D ne "D"
; then error 404
if CM-ARCHIVE-IND of COW-D eq "Y"
then error 405
display CULL-IND of COW-D
end
procedure edit TCOMPUTER
begin
do internal CHECK-RTN
let COMPUTER-NO of DEATH-D = TCOMPUTER
let COMPUTER-NO of ALPRO-UPDATE-D = TCOMPUTER
; get YARD-D via CLD-UNIT-YARD-NO using T-UY-NO
; if not accessok
; then error 24
end
procedure input EVAL-ID of DEATH-D
begin
if fieldtext = "*"
then begin
let EVAL = " "
run screen CWQK971N passing OCODE, EVAL mode f
if EVAL > " "
then let fieldtext = EVAL
end
end
procedure edit EVAL-ID of DEATH-D
begin
if EVAL-TYPE of EVAL-M ne "U" and EVAL-TYPE of EVAL-M ne "V"
then error 355
end
;mig procedure input REAS-CD of DEATH-D
;mig begin
;mig if fieldtext = "*"
;mig then begin
;mig let REAS = " "
;mig run screen CWQK975N passing OCODE, REAS MODE F
;mig if REAS > " "
;mig then let fieldtext = REAS
;mig end
;mig if 0 = size(fieldtext) and occurrence eq 1
;mig then edit REAS-CD of DEATH-D
;mig end
;---------------- MIG CODE BEGINS ---------------------
procedure input REAS-CD1 of DEATH-D
begin
if fieldtext = "*"
then begin
let REAS = " "
run screen CWQK975N passing OCODE, REAS MODE F
if REAS > " "
then let fieldtext = REAS
end
if 0 = size(fieldtext) and occurrence eq 1
then edit REAS-CD1 of DEATH-D
end
procedure input REAS-CD2 of DEATH-D
begin
if fieldtext = "*"
then begin
let REAS = " "
run screen CWQK975N passing OCODE, REAS MODE F
if REAS > " "
then let fieldtext = REAS
end
end
procedure input REAS-CD3 of DEATH-D
begin
if fieldtext = "*"
then begin
let REAS = " "
run screen CWQK975N passing OCODE, REAS MODE F
if REAS > " "
then let fieldtext = REAS
end
end
;---------------- MIG CODE ENDS ---------------------
procedure internal UPD-YD
begin
get YARD-D via CLD-UNIT-YARD-NO using T-UNIT-YARD
let YARD-TOTAL-COW of YARD-D = YARD-TOTAL-COW of YARD-D - 1
let YARD-ALPRO-NAME of ALPRO-UPDATE-D = YARD-ALPRO-NAME of YARD-D
if CM-BREED-STATUS of COW-D eq "O" or &
CM-BREED-STATUS of COW-D eq " "
then let YARD-OPEN-NOS of YARD-D = YARD-OPEN-NOS of YARD-D - 1
if CM-BREED-STATUS of COW-D eq "P"
then let YARD-PREG-NOS of YARD-D = YARD-PREG-NOS of YARD-D - 1
if CM-BREED-STATUS of COW-D eq "S"
then let YARD-SERVED-NOS of YARD-D = YARD-SERVED-NOS of YARD-D - 1
if CM-BREED-STATUS of COW-D eq "B"
then let YARD-BREEDER-NOS of YARD-D = YARD-BREEDER-NOS of YARD-D - 1
if CM-BREED-STATUS of COW-D eq "F"
then let YARD-FEEDER-NOS of YARD-D = YARD-FEEDER-NOS of YARD-D - 1
if CM-BREED-STATUS of COW-D eq "V"
then let YARD-VEALER-NOS of YARD-D = YARD-VEALER-NOS of YARD-D - 1
if CM-LACT-IND of COW-D eq "L"
then let YARD-MILKING-COW of YARD-D = YARD-MILKING-COW of YARD-D - 1
if CM-LACT-IND of COW-D eq "N" and SEX of COW-D ne "B"
then let YARD-DRY-NOS of YARD-D = YARD-DRY-NOS of YARD-D - 1
let YARD-NO of ALPRO-UPDATE-D = YARD-NO of YARD-D
put YARD-D
end
procedure preupdate
begin
if newrecord of DEATH-D
then begin
get BREED-SUMM-D via CLD-COMPUTER-NO using TCOMPUTER &
backwards opt
if accessok
then if BS-END-DATE = 0
then let BS-END-DATE of BREED-SUMM-D = DEATH-DATE
get LACT-SUMM-D via CLD-COMPUTER-NO using TCOMPUTER &
backwards opt
if accessok
then if LS-LACT-EDATE of LACT-SUMM-D = 0
then begin
let LS-LACT-EDATE of LACT-SUMM-D = DEATH-DATE
let LS-END-CAUSE of LACT-SUMM-D = "Death"
end
let CM-ARCHIVE-IND of COW-D = "Y"
let CM-DEAD-SOLD-IND of COW-D = "D"
let CM-DEAD-SLD-DATE of COW-D = DEATH-DATE
do internal UPD-YD
end
let BCS of COW-D = BCS of DEATH-D
let CM-BCS-LASTDATE of COW-D = DEATH-DATE
end
procedure update
begin
if newrecord of DEATH-D
then begin
if SEX of COW-D ne "B"
then begin
if alteredrecord of BREED-SUMM-D
then put BREED-SUMM-D
end
if SEX of COW-D eq "C"
then begin
if alteredrecord of LACT-SUMM-D
then put LACT-SUMM-D
end
end
put DEATH-D
put COW-D
let UNIT-NO of ALPRO-UPDATE-D = T-UNIT
let CLD-WORK-R of ALPRO-UPDATE-D = T-WORK
;--------------------------------------------------
get UNIT-M via UNIT-NO using T-UNIT optional
if ALPRO-NAME1 ne " " or ALPRO-NAME2 ne " "
then begin
let ALPRO-ADD-DEL-IND = "D"
put ALPRO-UPDATE-D
end
;-----------------------------------------------
end
procedure delete
disable
procedure internal GETPARMS
begin
edit DUMMY1
request T-UNIT
get UNIT-M via UNIT-NO using T-UNIT optional
if not accessok
then error 1
display UNIT-NAME
request SW-TYPE
if not promptok
then begin
let SW-TYPE = "W"
display SW-TYPE
end
else if SW-TYPE ne "W" and SW-TYPE ne "S"
then error 20
if SW-TYPE = "W"
then begin
request T-WORK
do internal CHECK-WORK
end
else begin
request T-SAFI
do internal CHECK-SAFI
end
end
procedure find
begin
;mig do internal GETPARMS ;moved to PATH procedure
get DEATH-D via COMPUTER-NO using TCOMPUTER
end
procedure path
begin
;mig - THIS PATH PROCEDURE WAS NOT EXISTING BEFORE.
;mig - It was added because GETPARAMS procedure was not executing while in FIND procedure
do internal GETPARMS
end
procedure postfind
begin
get COW-D via CLD-COMPUTER-NO using TCOMPUTER optional
if not accessok
then error 14
end
build
More information about the powerh-l
mailing list