Tweet
Hi
Is it possible to code Single Page Load in FREE format.
any one help me regarding this..
Thanx in advance
magesh
Is it possible to code Single Page Load in FREE format.
any one help me regarding this..
Thanx in advance
magesh
-
-
Re: Reg : Single page Subfile
Hi,
Please find the attachment.Thanx
satish
Anyone who has never made mistake has never tried anything new. -
Re: Reg : Single page Subfile
Well that is not exactly /Free but will work.
You could look here for examples of /free --> http://www.code400.com/viewsamples.php?lang_id=1Hunting down the future ms. Ex DeadManWalks. *certain restrictions applyComment
-
Re: Reg : Single page Subfile
DMW,
That’s still not exactly /FREE!
Here is the source to a windowed, page at a time, subfile select with multiple columns, in free, submitted for your approval…
DDS for the display file:
And the RPG code (in /FREE this time):Code:A DSPSIZ(24 80 *DS3) A MSGLOC(24) A PRINT A CF01(03 'Exit') A CF02(12 'Cancel') A R PDD020A SFL A SFLNXTCHG A APPPATH R H REFFLD(APPPATH AGP019) A PICKED 1A B 7 2 A N31 DSPATR(ND) A 31 DSPATR(PC) A N31 DSPATR(PR) A ANNVDATE R O 7 6REFFLD(ANNVDATE AGP019) A DATFMT(*USA) A TEXT('Policy Anniv Date') A R PDD020B SFLCTL(PDD020A) A *DS3 SFLLIN(0005) A SFLSIZ(0020) A SFLPAG(0015) A WINDOW(PDD020C) A ROLLDOWN(26 'ROLLDOWN') A ROLLUP(27 'ROLLUP') A RTNCSRLOC(&RTNRCD &RTNFLD &RTNPOS) A OVERLAY A 81 SFLDSP A 81 SFLDSPCTL A N81 SFLCLR A 89 SFLEND(*MORE) A SFLPAG 4S 0H SFLRCDNBR A RTNRCD 10A H A RTNFLD 10A H A RTNPOS 4S 0H A 1 1DATE A EDTCDE(Y) A COMNTL 25A O 1 17 A WQPGMN 10A O 1 48 A 2 1TIME A 2 18'STATEMENT PDF SELECTION' A DSPATR(HI) A DSPATR(UL) A 2 48'PDD020B' A 31 5 3'Type option, press Enter.' A COLOR(BLU) A 31 5 29'1=Select' A COLOR(BLU) A 31 6 1'Opt' A DSPATR(HI) A DSPATR(UL) A 6 6'Ann Date ' A DSPATR(HI) A DSPATR(UL) A 31 6 20'Opt' A DSPATR(HI) A DSPATR(UL) A HLPID(001) A 6 25'Ann Date ' A DSPATR(HI) A DSPATR(UL) A 31 6 39'Opt' A DSPATR(HI) A DSPATR(UL) A 6 44'Ann Date ' A DSPATR(HI) A DSPATR(UL) A 3 1'Policy#' A DSPATR(HI) A POLICY 6S 0O 3 9 A 3 17'Annuitant' A DSPATR(HI) A ANNNAM 30A O 3 27 A R PDD020C A OVERLAY A WINDOW(7 20 15 57) A WDWBORDER((*DSPATR RI)) A 13 2'F2=Cancel' A COLOR(BLU) A MESSAGE 40A O 14 10DSPATR(RI) A N30 DSPATR(ND) A R DUMMY ASSUME KEEP A 1 2' ' * * MESSAGE SUBFILE PANEL * A R MSGSFL SFL A SFLMSGRCD(24) A MSGKEY SFLMSGKEY A WQPGMN SFLPGMQ * * MESSAGE SUBFILE CONTROL PANEL * A R MSGCTL SFLCTL(MSGSFL) A OVERLAY A 80 SFLDSP A 80 SFLDSPCTL A 80 SFLINZ A 80 SFLEND A SFLSIZ(0005) A SFLPAG(0001) A WQPGMN SFLPGMQ
This app did not need a postion to field so that code is missing.Code:H DEBUG OPTION( *SRCSTMT: *NODEBUGIO ) DATFMT( *USA ) FCOMPANY IF E DISK * Company file FAGL019P IF E K DISK INFDS( DBFD ) F RENAME( AGP019A : DBRECORD ) * Standard Template Physical File FPDD020 CF E WORKSTN INFDS( DSPD ) F SFILE( PDD020A : SFLRRN ) * Prototyped call definitions D DisplayPDF PR EXTPGM( 'WAB010' ) D DocType 1A D FileName LIKE(APPPATH) * System data structures D PGMD ESDS D DBFD E DS D DSPD E DS * Message work variables - Note: MSGF is not used in window programs D NoRecords C 'No records found' D SelectErr C 'Selection invalid. 1=Select' D TopOfSfl C 'Top of list encountered' D BottomSfl C 'Bottom of list encountered' * Program work variables D Routine S 10 INZ( 'ClrSubFile' ) D SFLRRN S LIKE( SFLPAG ) D Key1 S LIKE( POLICY ) D FileName S LIKE( APPPATH ) D DocType S 1A INZ('S') D AlphaPolicy S 6A D i S 2 0 * Named indicators D DS Based( IndicatorP ) D Cancel 12 12N D RollDown 26 26N D RollUp 27 27N D Error 30 30N D SelectAbled 31 31N D OpenError 76 76N D DspMessage 80 80N D SflDsp 81 81N D SflDspCtl 82 82N D SflClr 83 83N D LastRecord 89 89N D SubfileEOF 90 90N D RcdNotFound 99 99N D IndicatorP S * Inz( %Addr( *In ) ) C *ENTRY PList C Parm AlphaPolicy * Database key C DBKEYS Klist C Kfld KEY1 /FREE // Get the company name Chain 1 COMPANY; If NOT %FOUND( COMPANY ) Or %ERROR; *INLR = *ON; Return; EndIf; COMNTL = SHORTNM; POLICY = %INT( AlphaPolicy ); KEY1 = POLICY; // Set error message display indicator Error = *OFF; // Always display the message subfile DspMessage = *ON; // Set display attributes based on call type SelectAbled = *ON; // Mainline DoW NOT Cancel; Select; When Routine = 'ClrSubFile'; ExSr ClrSubFile; When Routine = 'LodSubFile'; ExSr LodSubFile; When Routine = 'Screen'; ExSr Screen; When Routine = 'SelectRec'; ExSr SelectRec; When Routine = 'RollUpSub'; ExSr RollUpSub; EndSl; EndDo; *INLR = *ON; //========================================================================== // Subroutine - Clear Subfile //========================================================================== BegSr ClrSubFile; SflDsp = *OFF; SflDspCtl = *OFF; Clear SFLRRN; Clear PICKED; Write PDD020B; Routine = 'LodSubFile'; EndSr; //========================================================================== // Subroutine - Initial Load Of The Subfile //========================================================================== BegSr LodSubFile; SetLL DBKEYS DBRECORD; // Load a page of subfile records ExSr LoadAPage; If SFLRRN > *ZEROS; SFLPAG = 1; SflDsp = *ON; EndIf; ROUTINE = 'Screen'; EndSr; //========================================================================== // Subroutine - Load A Page Of The Subfile //========================================================================== BegSr LoadAPage; For i = 1 To 20; ReadE POLICY DBRECORD; // If EOF, get out If %EOF( AGL019P ); Leave; EndIf; // Otherwise, write the record SFLRRN = SFLRRN + 1; Write PDD020A; EndFor; // See if there are any more records to read *IN89 is EOF ReadE POLICY DBRECORD; If NOT( %EOF ); ReadPE POLICY DBRECORD; Else; LastRecord = *ON; EndIf; EndSr; //========================================================================== // Subroutine - Display Screen //========================================================================== BegSr Screen; // Display subfile SflDspCtl = *ON; // No records to display error If SFLRRN = *ZEROS; Error = *ON; MESSAGE = NoRecords; EndIf; Write PDD020C; Exfmt PDD020B; Error = *OFF; Select; // Rollup When RollUp And NOT( %EOF ) And SFLRRN > *ZEROS; Routine = 'RollUpSub'; // Rollup - but end of file When RollUp And %EOF; Error = *ON; MESSAGE = BottomSfl; Routine = 'Screen'; // Rolldown When RollDown; Error = *ON; MESSAGE = TopOfSfl; SFLPAG = 1; Routine = 'Screen'; // Enter pressed When NOT RollDown And NOT RollUp And SFLRRN > *ZEROS; Routine = 'SelectRec'; EndSl; EndSr; //*========================================================================== // Subroutine - Rollup //========================================================================== BegSr RollUpSub; Clear PICKED; SFLPAG = WDTOTR + 1; SFLRRN = WDTOTR; ExSr LoadAPage; Routine = 'Screen'; EndSr; //========================================================================== // Subroutine - Look For Selected Subfile Record //========================================================================== BegSr SelectRec; // Priming read change ReadC PDD020A; DoW NOT( %EOF ); //SubfileEOF // If option code entered If PICKED <> *BLANKS; // Error if not a sanctioned selection code If PICKED <> '1'; Error = *ON; MESSAGE = SelectErr; Leave; EndIf; // Pull the renewal letter DisplayPDF( DocType : APPPATH ); // Cancel = *ON; // Leave; EndIf; ReadC PDD020A; EndDo; If NOT Cancel; SFLPAG = WDLOWR; EndIf; Routine = 'Screen'; EndSr;
And yes, I AM a white space junky.
And it is SO rare that I beat Jamie to a post! Ya punk, I'm feelin' lucky!
HTH,
MdnghtPgmrLast edited by MdnghtPgmr; September 7, 2006, 07:20 AM."Tis better to be thought a fool then to open one's mouth and remove all doubt." - Benjamin FranklinComment
-
Re: Reg : Single page Subfile
Im getting old and slow....my son kicked the snot outta me last night
AS400pro is at it again
All my answers were extracted from the "Big Dummy's Guide to the As400"
and I take no responsibility for any of them.
www.code400.comComment
-
Re: Reg : Single page Subfile
(singing and dancing...)
Go Midnight... Go Midnight .. It's your Birthday ... Go Midnight!!
WOO Hoo!!!
Comment
-
Re: Reg : Single page Subfile
Rick,
Try switching to decaf my man! Woo Hoo indeed! BTW my b-day is 21 days away, this gives you plenty of time to save up for my gift!
Waiting for gifts in the mail,
MdnghtPgmr"Tis better to be thought a fool then to open one's mouth and remove all doubt." - Benjamin FranklinComment
-
Re: Reg : Single page Subfile
Just post you full name and address as well as your SS# and maybe a bank account number and we will all send you something special
jamieAll my answers were extracted from the "Big Dummy's Guide to the As400"
and I take no responsibility for any of them.
www.code400.comComment
-
Re: Reg : Single page Subfile
Jamie,
Okay! Coming soon to a post near you...
MdnghtPgmr"Tis better to be thought a fool then to open one's mouth and remove all doubt." - Benjamin FranklinComment
-
Re: Reg : Single page Subfile
Hi
Thanx a lot
mageshComment
Comment