|
midrange.com
OK this is more refined now.
This subroutine, displays all the records that the user put a '4' next to
on the first subfile, for deletion. Then program then displays all such
records as a subfile confirmation screen, then the user can hit enter for
delete.
The need now is that the data is tricky. Some records w/ the ACCT number
can have multiple BOL #'s associated. So the need is that if the
user puts a '4' next to say:
OPT ACCT BOL
4 10001 1
Then the confirm subfile should show:
ACCT BOL
10001 1
10001 2
even though no '4' was placed by the second record. (there could be
thousands of lines per order.) I have a logical for this file based on
ACCT & BOL, so a READE there would get all the records, but I am
not sure how to fold in this READE.
THe code that does this is:
C when option = delete
C eval rrn2 = rrn2 +1
C write sfl2
C eval *in74 = *on
C update sfl1
C eval *in74 = *off
C endsl
C readc sfl1
C enddo
C if rrn2 > 0
C eval lstrrn2 = rrn2
C eval rrn2 = 1
C write fkey2
C exfmt sf2ctl
C if (cfkey <> exit) and (cfkey <> cancel)
C exsr dltrcd
C asnkey setll mllc1wpk
C exsr clrsf1
C exsr sflbld
C endif
C endif
C
C endsr
*
The DDS:
A DSPSIZ(24 80 *DS3)
A PRINT
A ERRSFL
A CA03
A CA12
A*
A R SFL1 SFL
A*
A 74 SFLNXTCHG
A OPTION 1A B 10 3VALUES(' ' '2' '4' '5')
A BAACCT R O 10 7REFFLD(MLF01/BAACCT *LIBL/M
A BAINVN R O 10 21REFFLD(MLF01/BAINVN *LIBL/M
A BABOL R O 10 38REFFLD(MLF01/BABOL *LIBL/M
A BAPRO R O 10 56REFFLD(MLF01/BAPRO *LIBL/M
A BASTAT R O 10 74REFFLD(MLF01/BASTAT *LIBL/M
A BASERL R H REFFLD(MLF01/BASERL *LIBL/M
A BACTN1 R H REFFLD(MLF01/BACTN1 *LIBL/M
A BACTN2 R H REFFLD(MLF01/BACTN2 *LIBL/M
A BASDPN R H REFFLD(MLF01/BASDPN *LIBL/M
A BACHKD R H REFFLD(MLF01/BACHKD *LIBL/M
A BATRL# R H REFFLD(MLF01/BATRL# *LIBL/M
A R SF1CTL SFLCTL(SFL1)
A*
A CF06
A SFLSIZ(0013)
A SFLPAG(0012)
A ROLLUP
A OVERLAY
A N32 SFLDSP
A N31 SFLDSPCTL
A 31 SFLCLR
A 90 SFLEND(*MORE)
A RRN1 4S 0H SFLRCDNBR
A 9 7'ACCT#'
A DSPATR(HI)
A 9 21'INVOICE'
A DSPATR(HI)
A 9 37'BOL # '
A DSPATR(HI)
A 9 55'PRO # '
A DSPATR(HI)
A 9 72'STAT'
A DSPATR(HI)
A 1 2'MLD21U'
A 1 71DATE
A EDTCDE(Y)
A 2 71TIME
A 1 24'ASN READY TO SEND - UPDATE
'
A DSPATR(HI)
A 4 2'POSITION TO . . . ACCT'
A PACCT R B 4 30REFFLD(MLF01/BAACCT *LIBL/M
A DSPATR(HI)
A 9 2'OPT'
A DSPATR(HI)
A 6 2'TYPE OPTIONS, PRESS ENTER.
A COLOR(BLU)
A 7 4'2=CHANGE'
A COLOR(BLU)
A 7 19'4=DELETE'
A COLOR(BLU)
A 7 34'5=DISPLAY'
A COLOR(BLU)
A*
A R PANEL1
A 1 2'MLD21URG'
A MODE 6 O 2 2DSPATR(HI)
A 1 24'ASN PROGRAM WITH UPDATE'
A DSPATR(HI)
A 1 71DATE
A EDTCDE(Y)
A 2 71TIME
A BAACCT R O 4 23REFFLD(MLF01/BAACCT *LIBL/M
A DSPATR(HI)
A BAINVN R O 6 23REFFLD(MLF01/BAINVN *LIBL/M
A DSPATR(HI)
A BABOL R B 8 23REFFLD(MLF01/BABOL *LIBL/ML
A
A BAPRO R B 10 23REFFLD(MLF01/BAPRO *LIBL/ML
A
A BASTAT R O 12 23REFFLD(MLF01/BASTAT *LIBL/M
A DSPATR(HI)
A BASRPN R B 14 23REFFLD(MLF01/BASRPN *LIBL/M
A BALRPN R B 16 23REFFLD(MLF01/BALRPN *LIBL/M
A BASCAC R B 18 23REFFLD(MLF01/BASCAC *LIBL/M
A 42 19 23'INVALID CARRIER CODE'
A 42 DSPATR(HI)
A 42 DSPATR(UL)
A 42 COLOR(RED)
A N42 19 23' '
A BACARR R B 20 23REFFLD(MLF01/BACARR *LIBL/M
A BAAPPT R B 21 23REFFLD(MLF01/BAAPPT *LIBL/M
A BACTN1 R O 10 53REFFLD(MLF01/BACTN1 *LIBL/M
A EDTCDE(Z)
A DSPATR(HI)
A BACTN2 R O 12 53REFFLD(MLF01/BACTN2 *LIBL/M
A EDTCDE(Z)
A DSPATR(HI)
A BASERL R O 14 53REFFLD(MLF01/BASERL *LIBL/M
A DSPATR(HI)
A BASDPN R O 16 59REFFLD(MLF01/BASDPN *LIBL/
A DSPATR(HI)
A BACHKD R O 14 70REFFLD(MLF01/BACHKD *LIBL/
A DSPATR(HI)
A BATRL# R B 22 23REFFLD(MLF01/BATRL# *LIBL/
A 23 2'F3=EXIT'
A COLOR(BLU)
A 23 12'F12=CANCEL'
A COLOR(BLU)
A 4 3'ACCOUNT NUMBER . :'
A 6 3'INVOICE NUMBER . .'
A 8 3'BOL NUMBER . . .'
A 10 3'PRO NUMBER . . .'
A 9 53'CARTON # . . .'
A 11 53'OF . . .'
A 12 3'STATUS . . .'
A 13 53'SERIAL NUMBER . . .'
A 14 3'PART NUMBER . . .'
A 43 15 3'PART & LABEL # MUST BE EQU
A 43 DSPATR(HI)
A 43 DSPATR(UL)
A 43 COLOR(RED)
A N43 15 3'
A 15 53'MODEL NUMBER . . .'
A 16 3'LABEL NUMBER . . .'
A 18 3'CAC NUMBER . . .'
A 20 3'CARRIER # . . .'
A 21 3'APPT . . .'
A 22 3'TRAILER # . . .'
A 24 2'PRESS ENTER TO ACCEPT CHAN
A COLOR(BLU)
A R PANEL2
A*
A 1 2'MLD21URG'
A MODE 6 O 2 2DSPATR(HI)
A 1 24'ASN READY TO SEND -UPDATE'
A DSPATR(HI)
A 1 71DATE
A EDTCDE(Y)
A 2 71TIME
A DSPATR(HI)
A BAACCT R O 4 23REFFLD(MLF01/BAACCT *LIBL/M
A BAINVN R O 6 23REFFLD(MLF01/BAINVN *LIBL/M
A BABOL R O 8 23REFFLD(MLF01/BABOL *LIBL/ML
A BAPRO R O 10 23REFFLD(MLF01/BAPRO *LIBL/ML
A BASTAT R O 12 23REFFLD(MLF01/BASTAT *LIBL/M
A BASERL R O 14 23REFFLD(MLF01/BASERL *LIBL/M
A BACTN1 R O 16 23REFFLD(MLF01/BACTN1 *LIBL/M
A BACTN2 R O 18 23REFFLD(MLF01/BACTN2 *LIBL/M
A BASDPN R O 20 23REFFLD(MLF01/BASDPN *LIBL/M
A BACHKD R O 21 23REFFLD(MLF01/BACHKD *LIBL/M
A BATRL# R O 22 23REFFLD(MLF01/BATRL# *LIBL/M
A 23 2'F3=EXIT'
A COLOR(BLU)
A 23 12'F12=CANCEL'
A COLOR(BLU)
A 4 3'ACCOUNT NUMBER:'
A 6 3'INVOICE NUMBER:'
A 8 3'BOL NUMBER . . :'
A 10 3'PRO NUMBER . . :'
A 12 3'STATUS . . :'
A R SFL2 SFL
A*
A BAACCT R O 7 3REFFLD(MLF01/BAACCT *LIBL/M
A BAINVN R O 7 29REFFLD(MLF01/BAINVN *LIBL/M
A BABOL R O 7 45REFFLD(MLF01/BABOL *LIBL/ML
A BAPRO R O 7 61REFFLD(MLF01/BAPRO *LIBL/ML
A BASTAT R O 7 77REFFLD(MLF01/BASTAT *LIBL/M
A BASERL R H REFFLD(MLF01/BASERL *LIBL/M
A BACTN1 R H REFFLD(MLF01/BACTN1 *LIBL/M
A BACTN2 R H REFFLD(MLF01/BACTN2 *LIBL/M
A BASDPN R H REFFLD(MLF01/BASDPN *LIBL/M
A BACHKD R H REFFLD(MLF01/BACHKD *LIBL/M
A BATRL# R H REFFLD(MLF01/BATRL# *LIBL/M
A R SF2CTL SFLCTL(SFL2)
A*
A SFLSIZ(0016)
A SFLPAG(0015)
A SFLDSP
A 41 SFLCLR
A N41 SFLDSPCTL
A N41 SFLEND(*MORE)
A OVERLAY
A RRN2 4S 0H
A 3 3'PRESS ENTER TO CONFIRM YOU
A S FOR DELETE.'
A COLOR(BLU)
A 4 3'PRESS F12=CANCEL TO RETURN
TO CHAN-
A GE YOUR CHOICES.'
A COLOR(BLU)
A 6 3'ACCOUNT NUMBER'
A DSPATR(HI)
A 6 29'INVOICE NUMBER'
A DSPATR(HI)
A 6 45'BOL NUMBER'
A DSPATR(HI)
A 6 59'PRO NUMBER'
A DSPATR(HI)
A 6 73'STATUS'
A DSPATR(HI)
A 1 28'CONFIRM DELETE OF RECORDS'
A DSPATR(HI)
A DSPATR(UL)
A COLOR(RED)
A R FKEY1
A*
A 23 2'F3=EXIT'
A COLOR(BLU)
A +3' '
A
A +3'F12=CANCEL'
A COLOR(BLU)
A R FKEY2
A*
A 23 2'F3=EXIT'
A COLOR(BLU)
A +3'F12=CANCEL'
A COLOR(BLU)
A 24 2'PRESS ENTER TO ACCEPT CHAN
A COLOR(BLU)
A R FKEY3
A*
A 23 2'F12=CANCEL'
A COLOR(BLU)
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.
