|
midrange.com
Greetings,
I am finishing up my last program as part of a group project at school.
The problem is being able to search a phone number by 1 or all 10 digits of
a phone number. E.g., if the user types 708 the user should see all of the
708 and above.
I know there are some very smart programmers who know how to solve this.
Qddssrc(display file)
A DSPSIZ(24 80 *DS3)
A REF(DATADICT)
A CA03(03)
A CA05(05)
A CF06(06)
A CF07(07)
A CA12(12)
A INDARA
A HELP
A ALTHELP(CA01)
A HLPTITLE('Search Name Help')
A HLPPNLGRP(EXTENDED PNL001)
� A*****************************************************************
� A* RECORD FORMAT FOR THE HEADER SCREEN
� A*****************************************************************
A R HEADER
A 1 3'SearchPDW'
A COLOR(BLU)
A 1 34'MORAINE VALLEY'
A COLOR(WHT)
A 1 71TIME
A COLOR(BLU)
A 2 3'PAH'
A COLOR(BLU)
A 2 33'MORTGAGE COMPANY'
A COLOR(WHT)
A 2 70DATE(*SYS *YY)
A EDTCDE(Y)
A COLOR(BLU)
A 3
-
-
A '
A DSPATR(UL)
A COLOR(BLU)
� A*****************************************************************
� A* WINDOW RECORD
� A*****************************************************************
A R PROMPT
A****** OVERLAY
A KEEP
A WINDOW(9 15 5 46 *NOMSGLIN)
A WDWBORDER((*COLOR BLU) +
A (*DSPATR RI) +
A (*CHAR ' '))
A WDWTITLE((*TEXT 'Customer
Search'))
A WDWTITLE((*TEXT +
A 'F3=Exit F5=Refresh')(*BOTTOM))
A H HLPARA(*FLD PHONE)
A HLPPNLGRP('PHONE' PNL001 )
A 3 1'Search Phone'
A PHONE R B 3 16REFFLD(CPHONE CMASTR)
A 50 DSPATR(RI PC) COLOR(RED)
� A*****************************************************************
A*Subfile Record Format - LIST OF NAMES THAT MEET THE INQUIRY
� A*****************************************************************
A R SFL01 SFL
A 77 SFLNXTCHG
A SELECT 1 0B 10 13DSPATR(UL)
A EDTCDE(4)
A 60 DSPATR(RI PC) COLOR(RED)
A SCLNAME R B 10 21REFFLD(@LNAME)
A 41 DSPATR(PR)
A SCFNAME R B 10 43REFFLD(@FNAME)
A 41 DSPATR(PR)
A SCPHONE R Y B 10 60REFFLD(@PHONE)
A 41 DSPATR(PR)
A EDTWRD('0( )& - ')
A EDTMSK('& && & ')
A SCNUMBR R H REFFLD(@CNUM)
A SCADDR1 R H REFFLD(@ADD1)
A SCCITY R H REFFLD(@CITY)
A SCSTATE R H REFFLD(@STATE)
A SCZIPCD R H REFFLD(@ZIP)
A SCEMAIL R H REFFLD(@EMAIL)
A*
� A*****************************************************************
� A* SUBFILE CONTROL RECORD - LIST OF NAMES MEETING INQUIRY
� A*****************************************************************
A R CTL01 SFLCTL(SFL01)
A SFLSIZ(0007)
A SFLPAG(0006)
A OVERLAY
A 40 SFLCLR
A 43 SFLDSPCTL
A 42 SFLDSP
A 92 SFLEND(*MORE)
A CSRLOC(OUTROW OUTCOL)
A DSPREC 4S 0H SFLRCDNBR
A OUTROW 3S 0H
A OUTCOL 3S 0H
A 4 14'CUSTOMERS WITH LAST NAME
BEGINNING-
A WITH:'
A COLOR(WHT)
A PHONE 10Y 0O 4 55COLOR(RED)
A 6 2'Type option, press Enter.'
A COLOR(BLU)
A N42 DSPATR(ND)
A 7 2'1=Select'
A COLOR(BLU)
A N42 DSPATR(ND)
A 9 11'SELECT'
A COLOR(WHT)
A DSPATR(UL)
A 9 21'LAST NAME'
A COLOR(WHT)
A DSPATR(UL)
A 9 43'FIRST NAME'
A COLOR(WHT)
A DSPATR(UL)
A 9 60'PHONE NO.'
A COLOR(WHT)
A DSPATR(UL)
� A*****************************************************************
� A* RECORD FORMAT FOR THE 3RD SCREEN DISPLAY
� A*****************************************************************
A R CHANGEWDW
A OVERLAY
A WINDOW(8 24 13 53 *NOMSGLIN)
A WDWTITLE((*TEXT 'Customer
Date -
A -
A SearchWDW') *LEFT)
A WDWBORDER((*COLOR BLU) (*DSPATR
RI)-
A (*CHAR ' '))
A WDWTITLE((*TEXT 'F3=Exit
F5=Refre-
A sh F12=Cancel') *LEFT *BOTTOM)
A H HLPARA(*FLD WCLNAME)
A HLPPNLGRP(DLNAME PNL001)
A H HLPARA(*FLD WCFNAME)
A HLPPNLGRP(DFNAME PNL001)
A H HLPARA(*FLD WCADDR1)
A HLPPNLGRP(DDSTRET PNL001)
A H HLPARA(*FLD WCCITY)
A HLPPNLGRP(DCITY PNL001)
A H HLPARA(*FLD WCZIPCD)
A HLPPNLGRP(DZIP PNL001)
A H HLPARA(*FLD WCPHONE)
A HLPPNLGRP(DPHONE PNL001)
A H HLPARA(*FLD WCEMAIL)
A HLPPNLGRP(DEMAIL PNL001)
A 2 2'Make Changes, Press ENTER'
A COLOR(BLU)
A 4 2'Custoemr Number:'
A 5 2'First Name.....:'
A 6 2'Last Name......:'
A 7 2'Address........:'
A 8 2'City...........:'
A 9 2'State..........:'
A 10 2'Zip Code.......:'
A 11 2'Phone Number...:'
A 12 2'Email Address..:'
A WCNUMBR R O 4 19REFFLD(@CNUM)
A EDTCDE(4)
A WCFNAME R B 5 19REFFLD(@FNAME)
A WCLNAME R B 6 19REFFLD(@LNAME)
A WCADDR1 R B 7 19REFFLD(@ADD1)
A WCCITY R B 8 19REFFLD(@CITY)
A WCSTATE R B 9 19REFFLD(@STATE)
A WCZIPCD R B 10 19REFFLD(@ZIP)
A WCPHONE R Y B 11 19REFFLD(@PHONE)
A EDTWRD('0( )& - ')
A EDTMSK('& && & ')
A WCEMAIL R B 12 19REFFLD(@EMAIL)
A COLOR(RED)
� A*****************************************************************
� A* RECORD FORMAT FOR THE FOOTER
� A*****************************************************************
A R FOOTER
A OVERLAY
A 23 2'F3=Exit'
A COLOR(BLU)
A 23 12'F5=Refresh'
A COLOR(BLU)
A 23 26'F12=Cancel'
A COLOR(BLU)
� A*****************************************************************
� A* ERROR MESSAGE SUBFILE RECORD FOR THE WINDOW
� A*****************************************************************
A R WMSGSFL SFL
A SFLMSGRCD(13)
A MSGKEY SFLMSGKEY
A PGMQ SFLPGMQ
� A*****************************************************************
� A* ERROR MESSAGE CONTROL RECORD FOR THE WINDOW
� A*****************************************************************
A R WMSGCTL SFLCTL(WMSGSFL)
A WINDOW(CHANGEWDW)
A OVERLAY
A N39 SFLDSPCTL SFLDSP SFLINZ SFLEND
A SFLSIZ(2)
A SFLPAG(1)
A @PGMQ SFLPGMQ
� A*****************************************************************
� A* RECORD FORMAT FOR THE ERROR MESSAGE SUBFILE
� A*****************************************************************
A R MSGSFL SFL
A SFLMSGRCD(24)
A MSGKEY SFLMSGKEY
A @PGMQ SFLPGMQ
� A*****************************************************************
� A* RECORD FORMAT FOR THE ERROR MESSAGE CONTROL RECORD
� A*****************************************************************
A R MSGCTL SFLCTL(MSGSFL)
A OVERLAY
A N39 SFLDSPCTL SFLDSP SFLINZ SFLEND
A SFLSIZ(2)
A SFLPAG(1)
A @PGMQ SFLPGMQ
A*----------------------------------------------------------*
A* Subfile Control Record for the Error Message
A*----------------------------------------------------------*
A R DUMMY
A ASSUME
A 1 2' '
*
and here is the RPGLESRC program
� ***************** FILE SPECIFICATIONS ***********************
� *
� * Progam Name: SearchPhone For: Moraine Valley Mortgage
� * Author: Phil Hayes
� * Completion Date:
� *
� * Purpose: Display customers based on search criteria of first two
� * letters of the last name. User can then select the
� * customer in which they want to view the complete
information
� * on in another display record.
� *
� *----------------------------------------------------------------
� * File Specification for this program
� *----------------------------------------------------------------
� FCMastR IF E K DISK
� FCMastLP# UF E K DISK RENAME(CMAST1:CMAST2)
� FSearchPDW CF E WORKSTN
� F SFILE(SFL01 :RRN1)
� F INFDS(CMDkey)
� F INDDS(DispInds)
� *--------------------------------------------------------------------*
� * Data structure for the message API's. *
� *--------------------------------------------------------------------*
� D DS INZ
� D @Stk 1 4B 0
� D @Len 5 8B 0 inz(80)
� D @Err 9 12B 0
�
� D @MsgF S 20 Inz('ERRMSGS *LIBL')
� D @Key S 4 Inz(' ')
� D @Rmv S 10 Inz('*ALL')
� D @MsgID S 7
� D @Dta S 80
� D @Type S 10 Inz('*DIAG')
� *----------------------------------------------------------------
� * Convert Lower Case to Upper Case
� *----------------------------------------------------------------
D Aphone S 10
� D Uc C
CONST('ABCDEFGHIJKLMNOPQRSTUVWXYZ')
� D Lc C
CONST('abcdefghijklmnopqrstuvwxyz')
*
� D CMDkey DS
� D Key 369 369
� *
� D Sdata1 E DS Extname(CmastL) Prefix(S)
� D Wdata1 E DS Extname(CmastL) Prefix(w)
� D Fdata1 E DS Extname(CmastL)
� *
� *---------------------------------------------------------------------
� * Defining Stand alone Variables used inside this PGM.
� *---------------------------------------------------------------------
� D LLimit S 20 INZ(*LoVal)
� D HLimit S 10 0 INZ(*HiVal)
� D VError S 1N INZ(*Off)
D IGotNmbr S 1N INZ(*Off)
D PHiNmbr S 10 0 inz(9999999999)
D RRN1 S 4P 0 INZ(0)
� *----------------------------------------------------------------
� * Data structure INDARA Indicator Array
� *----------------------------------------------------------------
� D DispInds DS
� D IExit 3 3N
� D IRefresh 5 5N
� D ICancel 12 12N
� D IMsgClr 39 39N
� D ISflClr 40 40N
D IDProtKey 41 41n
� D ISflDsp 42 42N
� D ISflDspCtl 43 43N
� D IDSelName 50 50N
� D ISflLinErr 60 60N
� D ISflNxtChg 77 77N
� D ISflMore 92 92N
� *
� *---------------------------------------------------------------------
� * Hexadecimal Constants for all Function Keys used in this PGM.
� *---------------------------------------------------------------------
I/copy inter26/qcpylesrc,cmdkey1
� *----------------------------------------------------------------
� * Mailine Section of the Program
� *----------------------------------------------------------------
C DoU IExit
C
C Write Header
C Write MsgCTL
C ExFmt Prompt
C
C Select
C
C When IExit
C Leave
C
C When ICancel
C Iter
C
C When IRefresh
C ExSr @Refresh
C
C When Key = Enter
C ExSr @LoadSFL
C ExSr @PickName
C
C EndSL
C EndDo
C
� C Eval *Inlr = *On
� *----------------------------------------------------------------
� * @LoadSFL Subrountine
� *----------------------------------------------------------------
� CSR @LoadSFL BegSR
C ExSr @ClearSFL
C ExSr @ClearMsg
C Phone SetLL CMastLP#
C Phone CHAIN CMastLP#
C Eval IGotNmbr = Cphone < PHiNmbr
C
C DoW Not %EOF and IGotNmbr = *ON
C Eval ISflLinErr = *Off
C Eval ISflNxtChg = *Off
C Eval IDProtKey= *On
C Eval Sdata1 = Fdata1
C Eval Select = *Zeros
� C Eval RRN1 = RRN1 + 1
� C Write SFL01
C Read CMastLP#
C Eval IGotNmbr = CPhone < PHiNmbr
� C EndDo
�
C If RRN1 = *Zeros
C Eval ISFLDSP = *off
C Eval ISflLinErr = *On
C Eval @msgid = 'ERR0101'
C Eval @dta = APhone
C Eval Outrow = 24
C Eval Outcol = 2
C Call 'QMHSNDPM' ParmSND
� C Else
C Eval ISflDsp = *On
C Eval DspRec = 1
C Eval Outrow = *zeros
C Eval Outcol = *zeros
C End
� C Eval ISflMore = *Off
� C If Not %EOF
C Read CMastLP#
C Eval ISflMore = CPhone < PHiNmbr
C EndIf
�
� CSR EndSr
� *--------------------------------------------------------------------*
� * Remove the Message Subfile. *
� *--------------------------------------------------------------------*
� CSR @ClearMsg BegSR
� C Eval IMsgclr = *On
� C Write Msgctl
� C Eval IMsgclr = *Off
C Eval @Key = *Blanks
C Call 'QMHRMVPM' ParmRMV
C
� CSR EndSR
� *--------------------------------------------------------------------*
� * @ClearSFL Subroutine *
� *--------------------------------------------------------------------*
� CSR @ClearSFL BegSR
C Eval RRN1 = 0
�
� C Eval ISflClr = *On
� C Write Ctl01
� C Eval ISflClr = *Off
� CSR EndSr
� *----------------------------------------------------------------
� * @Refresh Subroutine
� *----------------------------------------------------------------
� CSR @Refresh BegSR
C Clear Phone
� CSR EndSR
� *--------------------------------------------------------------------*
� * @PickName Subroutine *
� *--------------------------------------------------------------------*
� CSR @PickName BegSR
�
C DoU IExit or ICancel
C Write Header
C Write MsgCTL
C Write Footer
C ExFmt CTL01
C
C Select
C
C When IExit
C Leave
C
C When ICancel
C ExSr @ClearMsg
C Iter
� C When IRefresh
� C Exsr @ClearMsg
� C ExSR @ClearSFL
� C ExSR @LoadSFL
� C When Key = Enter and ISfldsp = *on
� C Exsr @Validate
C EndSL
C EndDo
� C EndSr
� *--------------------------------------------------------------------*
� * Read Changed Records In The Subfile To Check For Selection *
� *--------------------------------------------------------------------*
� CSR @UpdateWDW BegSR
C DoW Not ICancel
C Eval Wdata1 = Sdata1
C ExFmt ChangeWDW
C Select
C When IExit or ICancel
C Leave
� C When Key = Enter
C Eval Fdata1 = Wdata1
C**************** UpDate CMAST2
C Eval Sdata1 = Wdata1
C Leave
C EndSL
�
� C EndDO
�
� CSR EndSR
� *--------------------------------------------------------------------*
� * @Validate Subroutine - Validate Selection Numbers on SFL *
� *--------------------------------------------------------------------*
� CSR @Validate BegSR
C ReadC SFL01
C
C DoW not %EOF
C
� C* Edit the Select Screen
C
C Eval ISflLinErr = *Off
C Eval ISflNxtChg = *Off
� C Eval VError = *Off
� C* Edits?
� C If Select <> 0
� C If Select <> 1
� C
� C Eval ISflNxtChg = *On
� C Eval ISflLinErr = *On
� C Eval @msgid = 'ERR0100'
� C Call 'QMHSNDPM' ParmSND
C Else
C Exsr @Updatewdw
C Eval Select = 0
C End
C End
C Update SFL01
� C If ISflNxtChg = *On
C Leave
C End
� C ReadC SFL01
� C
� C EndDO
� C
� CSR EndSr
� C
� *--------------------------------------------------------------------*
� * @EditCkWDW Subroutine - Check Window I/P before Posting to the *
� * Data Base File - CMastR.PF
� *--------------------------------------------------------------------*
� C
� *--------------------------------------------------------------------*
� * Initialization Routine
� *--------------------------------------------------------------------*
� CSR *InzSR BegSr
C Eval ISflDspCtl = *On
C Eval @PgmQ = '*'
�
C KeyFile KList
C KFld CLName
C KFld CNumbr
C
� * Clears messages from the PGM queue.
� C ParmRMV Plist
� C Parm @PgmQ
� C Parm @Stk
� C Parm @Key
� C Parm @Rmv
� C Parm @Err
� C
� * Sends messges to PGM queue.
� C ParmSND Plist
� C Parm @MsgID
� C Parm @MsgF
� C Parm @Dta
� C Parm @Len
� C Parm @Type
� c Parm @PgmQ
� C Parm @Stk
� C Parm @Key
� C Parm @Err
� CSR EndSr
I hope someone could solve this.
Thank You,
Phil
+---
| This is the RPG/400 Mailing List!
| To submit a new message, send your mail to RPG400-L@midrange.com.
| To subscribe to this list send email to RPG400-L-SUB@midrange.com.
| To unsubscribe from this list send email to RPG400-L-UNSUB@midrange.com.
| Questions should be directed to the list owner/operator: david@midrange.com
+---
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2025 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 copyright@midrange.com.
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.
