h datfmt(*iso) timfmt(*iso) option(*nodebugio) debug
?*===============================================================*
?* *
?* description - customer selection (browse) window *
?* *
?*===============================================================*
FDSPF CF E WORKSTN INFSR(*PSSR)
F SFILE(F01SFL:RRN)
FCUSNAMES IF E K DISK INFSR(*PSSR)
?* format slr05
?*===============================================================*
DCNAM S 35 VARYING
DDSEQ S 3 VARYING
?*===============================================================*
?* fetch external description of lda.
D LDA E DS EXTNAME(LDA)
D U#CUSN 295 302
D U#DSEQ 303 305
?* fetch external description of program status data structure.
D PSTAT ESDS EXTNAME(PSDS)
?* build work field containing search words from screen
DSearch_WORDS DS 46
D CUSNDS 1 8
D DSEQDS 9 11
D CNAMDS 12 46

?*===============================================================*
?* main line
?*===============================================================*

C Exsr #CLR
C Exsr #BLD

C Write F02
C Exfmt F01CTL

B01 C Dow PGMSTS<>'RTN'

B02 C IF *IN40=*ON
C Exsr #KEY
X02 C Else
C Exsr #VAL
E02 C EndIf

B02 C IF PGMSTS<>'RTN'
C Write F02
C Exfmt F01CTL
E02 C EndIf

E01 C EndDo

C Out LDA
C Eval *INLR=*ON
?*===============================================================*
?* # val validation.
?*===============================================================*
C #VAL Begsr

B02 C IF *IN31=*ON

C Reset X
C Reset @IN20
C Reset *IN20

C X Chain F01SFL 99

B03 C Dow *IN99=*OFF

B04 C IF SELCSF<>*BLANK
S05 C Select
?* select.
C When SELCSF='1'

C Eval U#CUSN=CUSNSF
C Eval U#DSEQ=DSEQSF

C Eval PGMSTS='RTN'
C Leave

C Other
C Eval PGMSTS='BAD'
C Eval *IN20=*ON
C Eval @IN20=*ON
C Eval @RRN=RRN
E05 C EndSl
E04 C EndIf

C Update F01SFL

C Eval *IN20=*OFF

C Eval X=(X+1)
C X Chain F01SFL 99
E03 C EndDo

C Eval *IN20=@IN20

E02 C EndIf
?* check for rebuild based on selection being non-blank or changing
B01 C IF Search_WORDS <> *BLANKS or
C Search_WORDS <> Search_PRV
C Exsr #CLR
C Exsr #BLD
X01 C Else
E01 C EndIf

C Endsr
?*===============================================================*
?* # key function keys.
?*===============================================================*
C #KEY Begsr

S01 C Select
?* page down (*in36).
C When *IN36=*ON
C Exsr #BLD
?* f12 = exit.
C When *INKL=*ON
C Eval PGMSTS='RTN'

E01 C EndSl

C Endsr
?*===============================================================*
?* # bld build subfile.
?*===============================================================*
C #BLD Begsr

C Reset X

C Eval CNAM=%TRIM(CNAMDS)
C Eval DSEQ=%TRIM(DSEQDS)

C L#CONO Reade SLR05 34

B01 C Dow *IN34=*OFF AND
C X<16
?* ignore deleted customers.
B02 C IF RSTS05 <>'D'
?* default the scan indicators to on=found
C Seton 5060
?* scan customer name.
B03 C IF CNAMDS <>*BLANKS
C CNAM Scan CNAM05 50
E03 C EndIf
?* scan customer delivery points
B03 C IF DSEQDS <>*BLANKS
C DSEQ Scan DSEQ05 60
E03 C EndIf

?* assuming both scan words (seq and cnam) are found then load
B03 C IF *IN50 =*ON AND
B03 C *IN60 =*ON

C Clear SELCSF
C Eval CUSNSF =CUSN05
C Eval DSEQSF =DSEQ05
C Eval CNAMSF =CNAM05

C Add 1 RRN
C Add 1 X
C Write F01SFL

E03 C EndIf
E02 C EndIf

C L#CONO Reade SLR05 34
E01 C EndDo
?* set display according to results.
B01 C IF RRN=*ZEROS
C Movel *ON *IN52
X01 C Else
C Movel *ON *IN31
C Eval @RRN=RRN
E01 C EndIf

C Endsr
?*===============================================================*
?* # clr clear subfile and set up headers.
?*===============================================================*
C #CLR Begsr

C Movel *OFF *IN52
C Movel *ON *IN51
C Write F02
C Movel *OFF *IN51
?* clear subfile.
C Clear RRN
C Z-add 1 @RRN
C Movel *OFF *IN30
C Movel *OFF *IN31
C Movel *ON *IN32
C Write F01CTL
C Movel *OFF *IN32
C Movel *ON *IN30

B01 C IF CUSNDS<>*BLANKS
C SLP05K1 Setll SLR05
X01 C Else
C L#CONO Setll SLR05
E01 C EndIf

C Clear CUSNDS
C Eval Search_PRV = Search_WORDS

C Endsr
?*===============================================================*
?* * inzsr initialisation.
?*===============================================================*
C *INZSR Begsr

C *DTAARA Define *LDA LDA
C In LDA
?* key lists.
C SLP05K1 Klist
C Kfld L#CONO
C Kfld CUSNDS
?* work fields etc.
?* definitions.
C *LIKE Define @RRN RRN
C *LIKE Define @RRN X
C *LIKE Define Search_WORDS Search_PRV

C Movel 'OK ' PGMSTS 3
C Movel *OFF @IN20 1
C Eval X=1

C Endsr
?* standard error handling.
?/Copy qgpl/qrpglesrc,pssr
?*===============================================================**

And here is the DSPF for it:

A DSPSIZ(24 80 *DS3)
A VLDCMDKEY(40)
A CA12
A R F02
A WINDOW(1 17 19 51)
A WDWBORDER((*COLOR RED))
A USRRSTDSP
A WDWTITLE((*TEXT 'Customer by Sequen-
A ce Inquiry ') (*COLOR WHT))
A WDWTITLE((*TEXT '1=Select F12=Prev-
A ious') (*COLOR WHT) *BOTTOM)
A R F01SFL SFL
A SELCSF 1A B 1 2CHECK(ER)
A 20 DSPATR(RI)
A 20 DSPATR(PC)
A VALUES('1' ' ')
A CUSNSF 8A O 1 4
A DSEQSF 3A O 1 13
A CNAMSF 35A O 1 17
A R F01CTL SFLCTL(F01SFL)
A N34 PAGEDOWN(36)
A BLINK
A OVERLAY
A 31 SFLDSP
A 30 SFLDSPCTL
A 32 SFLCLR
A 34 SFLEND(*MORE)
A SFLSIZ(0016)
A SFLPAG(0015)
A 20 SFLMSG('Not Valid for Selection.' 2-
A 0)
A WINDOW(F02)
A WDWBORDER((*CHAR ' '))
A @RRN 4S 0H SFLRCDNBR
A 17 2'View Customer list by entering par-
A tial values'
A 18 2':'
A CUSNDS 8A B 18 4DSPATR(PC)
A DSPATR(HI)
A DSEQDS 3A B 18 13DSPATR(PC)
A DSPATR(HI)
A CNAMDS 35A B 18 17DSPATR(HI)
A R ASSUME
A ASSUME
A DUMMY 1 1 70