Monday, October 1, 2007

The RPGIV for the two subfile program








*************************************************************
* A program to select from 2 different subfiles *
* 11/03 Booth Martin *
* *
* *
*************************************************************
H option(*nodebugio)
FTEST00D CF E WORKSTN
F SFILE(SFLA:RRN)
F SFILE(SFLB:RRNB)
FTEST01P IF E K DISK
FTEST02P IF E K DISK

D RRN S 4S 0
D RRNB S 4S 0
D TopRec S 4s 0
D SavedStates S Like(States)
* ..................................................
C EXSR FillSubfileASR
C EXSR FillSubfileBSR

C DoW *INLR = *Off
C write (e) Header
C write (e) Footer
* set the top of subfile A:
* Here you may choose to have subfile A positioned to either:
* 1) The State chosen,
* (use RelRcd > 0)
* 2) or, the same way as SFLA was when the selection was made,
* (use TopRecIn > 0)
* 3) or, always reposition to the beginning of SFLA.
* (comment or delete this section)
C If Relrcd > 0
C eval TopRec = RelRcd
C* If TopRecIn > 0
C* eval TopRec = TopRecIn
C else
C eval TopRec = 1
C endif

C if FLD = *Blanks
C write (e) FMT02
C exfmt FMT01
C Read (e) FMT02
C Read (e) Footer
C else
C write (e) FMT01
C exfmt FMT02
C Read (e) FMT01
C Read (e) Footer
C endif

C Select
* Footer Push button Choices:
* end the job
C When *INKC or
C *INKL
C Eval *INLR = *ON

* Fill cities subfile:
C When FLD > *Blanks
C RELRCD chain (e) SFLA
C exsr FillSubfileBSR

C EndSL
C END
* _________________________________________________________________
C FillSubfileAsrBegSR
* fill SFLA
C eval RRN = 0
* Clear subfile & screen, prepare to re-fill or fill:
C Eval *IN90=*off
C Clear SFLA
C Write FMT01
C eval *IN90 = *on

C *LoVal Setll Test01P
C Read Test01P
C DoW Not %EOF(Test01P)
C Eval RRN = RRN + 1
C Write SFLA
C Read Test01p
C End

C Eval NBRREC = RRN
C RRN IFLT 5
C eval *IN91 = *on
C END

C ENDSR
* _________________________________________________________________
C FillSubfileBsrBegSR
* fill SFLB
C eval RRNB = 0

C Eval *IN80=*off
C Clear SFLB
C eval Title = ' Cities '
C Write FMT02
C eval *IN80 = *on

C if RELRCD = *zeros
C Eval CITIES = *Blanks
C Eval RRNB = RRNB + 1
C Write SFLB
C else
C RELRCD Chain (e) SFLA
C eval SavedStates = States
C Eval Title = ' ' + STATES + ' '
C STATES Setll Test02P
C Read (e) Test02P
C If States <> SavedStates or
C %EOF(Test02P)
C eval cities = 'No cities listed'
C Eval RRNB = RRNB + 1
C Write SFLB
C else
C DoW Not %EOF(Test02P) and
C States = SavedStates
C Eval RRNB = RRNB + 1
C Write SFLB
C Read Test02P
C Enddo
C endif
C endif

C Eval NBRRECB = RRNB
C RRNB IFLT 5
C eval *IN81 = *on
C END

C EndSR
* _____________________________________________________


Reference Booth Martin.


DDS Source (Physical file source code)

Name of states file: TEST01P
A R TEST01REC
A STATES 10
A K STATES

Name of cities file: TEST02P
A R TEST02REC
A STATES 10
A CITIES 20
A K STATES
A K CITIES




DDS Source (Display file source code)

A DSPSIZ(24 80 *DS3)
A CHGINPDFT(HI UL)
A ERRSFL
A CA03(03 'Exit')
A CA12(12 'Exit')
A MOUBTN(*ULD ENTER)
A R HEADER
A 1 69DATE
A EDTCDE(Y)
A 2 69TIME
A* 3 69SYSNAME
A 3 69'SYSTEM X'
A 4 69USER
A 2 7' __ _-
A _ ___ _ __ '
A 3 7' / /_ _ __ ___ ___ __ __ / -
A / / _/(_)/ /___ ___ '
A 4 7' / __/| |/|/ // _ \ (_- / // // _-
A \ / _// // // -_)(_- '
A 5 7' \__/ |__,__/ \___/ /___/\_,_//_._-
A _//_/ /_//_/ \__//___/ '
A 6 7' -
A '
A R SFLA SFL
A STATES 10A O 2 1
A R FMT01 SFLCTL(SFLA)
A TEXT('States subfile')
A OVERLAY
A WINDOW(9 5 8 27 *NOMSGLIN)
A WDWTITLE((*TEXT ' States '))
A *DS3 SFLLIN(2)
A SFLPAG(0012)
A SFLSIZ(&NBRREC)
A* (can not use this with SFLLIN) SFLSNGCHC
A RTNCSRLOC(&REC &FLD)
A SFLCSRRRN(&RELRCD)
A 90 SFLDSP
A 90 SFLDSPCTL
A N90 SFLCLR
A 91 SFLEND(*SCRBAR *MORE)
* Use TopRecIn or RelRcd to set TopRec, which sets the position of SFLA:
A TOPREC 4S 0H SFLRCDNBR(*TOP)
A TOPRECIN 5S 0H SFLSCROLL
A RELRCD 5S 0H
A NBRREC 5S 0P
A REC 10A H
A FLD 10A H
A R SFLB SFL
A CITIES 20A O 2 2
A R FMT02 SFLCTL(SFLB)
A TEXT('Cities subfile')
A RTNCSRLOC(&RECB &FLDB)
A OVERLAY
A SFLCSRRRN(&RELRCDB)
A 80 SFLDSP
A 80 SFLDSPCTL
A N80 SFLCLR
A 81 SFLEND(*SCRBAR *MORE)
A SFLSIZ(&NBRRECB)
A SFLPAG(0006)
A WINDOW(9 45 8 26 *NOMSGLIN)
A WDWTITLE((*TEXT &TITLE))
A SFLMLTCHC
A RELRCDB 5S 0H
A NBRRECB 5S 0P
A RECB 10A H
A FLDB 10A H
A TITLE 12A P
A R FOOTER
A OVERLAY
A 23 3'F3=Exit F12=Return'
A COLOR(BLU)
A 20 46'Select as many cities as you like.'
A COLOR(BLU)
A 21 46'Use the space bar or mouse click'
A COLOR(BLU)
A 22 46'to make your selections.'
A COLOR(BLU)
A R DUMMY
A TEXT('PREVENTS PREVIOUS SCREEN FROM-
A BEING CLEARED')
A ASSUME
A 5 9' '

No comments:

Post a Comment