|
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 [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.
