Troubleshooting
Problem
The following is an RPG subfile example with a selection option. This example loads the entire subfile at one time.
Resolving The Problem
The following is an RPG subfile example with a selection option. This example loads the entire subfile at one time. Depending on your file, this may not be appropriate for your situation. If the file loads more than a couple of subfile pages, review the example to load one page at a time. Refer to RPG Subfile That Loads Subfile One Page at a Time.
Database Physical File TESTADD:
Database Logical File TESTLF:
Display File EXPSFL2:
RPG Program SFLRCDSEL2:
Database Physical File TESTADD:
A R FMT1
A ZIP 5A
A CUST 20A
A NAME 20A
A ADDR1 20A
A ADDR2 20A
A CITY 20A
A STATE 2A
A DATEOB 6 0
Database Logical File TESTLF:
A R FMT1 PFILE(TESTADD)
A K NAME
Display File EXPSFL2:
A DSPSIZ(24 80 *DS3)
A PRINT
A CF03(03)
A HELP
A****************************************************************
A* HEADER RECORD TO BE AT TOP OF DISPLAY
A****************************************************************
A R HEADER
A OVERLAY
A 2 3'HEADER'
A 2 70DATE
A 3 70TIME
A****************************************************************
A* SUBFILE RECORD
A****************************************************************
A R SF SFL
A OPT 1A B 10 3
A ZIP 5A O 10 12
A CUST 20A O 10 27
A NAME 20A O 10 53
A****************************************************************
A* SUBFILE CONTROL RECORD
A****************************************************************
A R SCTL SFLCTL(SF)
A SFLSIZ(0008)
A SFLPAG(0007)
A OVERLAY
A 31 SFLDSP
A 32 SFLDSPCTL
A 33 SFLEND
A 34 SFLCLR
A 35 SFLINZ
A WDPOS 4S 0H SFLRCDNBR
A 5 2'Type options, press Enter'
A COLOR(BLU)
A 6 2'2=Change 5=Display'
A COLOR(BLU)
A 8 2'OPT'
A DSPATR(HI)
A 9 2'---'
A DSPATR(HI)
A 8 12'ZIP'
A DSPATR(HI)
A 9 12'-----'
A DSPATR(HI)
A 8 27'CUSTOMER'
A DSPATR(HI)
A 9 27'--------------------'
A DSPATR(HI)
A 8 53'CONTACT NAME'
A DSPATR(HI)
A 9 53'--------------------'
A DSPATR(HI)
A****************************************************************
A* WRITE IF SUBFILE IS EMPTY
A****************************************************************
A R EMPTY
A OVERLAY
A 8 12'THE SUBFILE IS EMPTY'
A****************************************************************
A* FOOTER RECORD TO BE WRITTEN AT THE BOTTOM OF THE DISPLAY
A****************************************************************
A R FOOTER
A OVERLAY
A 23 3'FOOTER'
A R CHANGE
A 1 23'Change customer Record'
A DSPATR(HI)
A 4 4'Make changes and press enter, to c-
A ancel changes press F3.'
A DSPATR(BL)
A COLOR(BLU)
A 7 4'Customer Name . . .:'
A 8 4'Contact Name . . .:'
A 9 4'Address Line 1 . .:'
A 10 4'Address Line 2 . .:'
A 11 4'City . . . . . . .:'
A 12 4'State . . . . . . .:'
A 13 4'Date of Birth . . .:'
A CUST R B 7 26REFFLD(FMT1/CUST *LIBL/TESTADD)
A CHECK(LC)
A NAME R B 8 26REFFLD(FMT1/NAME *LIBL/TESTADD)
A CHECK(LC)
A ADDR R B 9 26REFFLD(FMT1/ADDR1 *LIBL/TESTADD)
A CHECK(LC)
A ADDR2 R B 10 26REFFLD(FMT1/ADDR2 *LIBL/TESTADD)
A CHECK(LC)
A CITY R B 11 26REFFLD(FMT1/CITY *LIBL/TESTADD)
A CHECK(LC)
A STATE R B 12 26REFFLD(FMT1/STATE *LIBL/TESTADD)
A DATEOB R B 13 26REFFLD(FMT1/DATEOB *LIBL/TESTADD)
A
A 23 4'F3 = Exit'
A COLOR(BLU)
A R DISPLAY
A*%%TS SD 19970421 104010 *LIBL REL-V2R3M0 5738-PW1
A 1 23'Change customer Record'
A DSPATR(HI)
A 4 4'Make changes and press enter, to c-
A ancel changes press F3.'
A DSPATR(BL)
A COLOR(BLU)
A 7 4'Customer Name . . .:'
A 8 4'Contact Name . . .:'
A 9 4'Address Line 1 . .:'
A 10 4'Address Line 2 . .:'
A 11 4'City . . . . . . .:'
A 12 4'State . . . . . . .:'
A 13 4'Date of Birth . . .:'
A 23 4'F3 = Exit'
A COLOR(BLU)
A CUST R O 7 26REFFLD(FMT1/CUST *LIBL/TESTADD)
A NAME R O 8 26REFFLD(FMT1/NAME *LIBL/TESTADD)
A ADDR1 R O 9 26REFFLD(FMT1/ADDR1 *LIBL/TESTADD)
A ADDR2 R O 10 26REFFLD(FMT1/ADDR2 *LIBL/TESTADD)
A CITY R O 11 26REFFLD(FMT1/CITY *LIBL/TESTADD)
A STATE R O 12 26REFFLD(FMT1/STATE *LIBL/TESTADD)
A DATEOB R O 13 26REFFLD(FMT1/DATEOB *LIBL/TESTADD)
RPG Program SFLRCDSEL2:
**FREE
Dcl-F TESTLF Usage(*Update:*Delete) Keyed;
Dcl-F EXPSFL2 WORKSTN
SFILE(SF:RRN);
Dcl-S RRN Packed(4:0);
//
//***************************************************************
//
// CLEAR SFL
//
//***************************************************************
*In31 = '0';
*In32 = '0';
*In33 = '0';
*In34 = '1';
Write SCTL;
*In31 = '0';
*In32 = '1';
*In33 = '0';
*In34 = '0';
//
//***************************************************************
//
// LOAD SUBFILE
// THIS PROGRAM LOADS THE ENTIRE SUBFILE. THIS IS NOT VERY
// EFFICIENT IF THERE ARE MORE THAN A COUPLE SUBFILE PAGES
// OF DATA IN THE DATABASE FILE. IF THERE IS TOO MUCH DATA
// YOU SHOULD CONSIDER LOADING THE SUBFILE ONE PAGE AT A TIME.
//
// NOTICE THE READ WITH NO LOCK SO THAT NO RECORDS HAVE A
// LOCK AFTER LOADING THE SUBFILE.
//
//***************************************************************
// INITIALIZE SFL RRN
RRN = 0;
//
Read(N) FMT1;
*IN90 = %Eof;
DoW *IN90 = '0'
and RRN <= 9998;
RRN += 1;
Write SF;
Read(N) FMT1;
*IN90 = %Eof;
EndDo;
*IN33 = '1';
//***************************************************************
//
// CHECK TO SEE IF SUBFILE HAS ANY RECORDS.
// IF THERE ARE RECORDS THEN SET ON THE SFLDSP INDICATOR.
//
// IF THERE ARE NOT ANY RECORDS IN THE SUBFILE THEN WRITE
// THE EMPTY RECORD FORMAT.
//
//***************************************************************
If RRN > 0;
*IN31 = '1';
Else;
Write EMPTY;
EndIf;
//***************************************************************
//
// WRITE EVERYTHING TO THE DISPLAY.
//
//***************************************************************
DoW *IN03 = '0';
Write HEADER;
Write FOOTER;
// POSITION THE SUBFILE TO THE PAGE THAT CONTAINS RELATIVE
// RECORD NUMBER 1.
WDPOS = 1;
Exfmt SCTL;
If *IN03 = '0';
ReadC SF;
*IN80 = %Eof;
DoW *IN80 = '0';
If OPT = '2';
CHNG();
Else;
If OPT = '5';
DISP();
Else;
// SEND OUT ERROR
EndIf;
EndIf;
OPT = ' ';
*IN30 = '1';
Update SF;
ReadC SF;
*IN80 = %Eof;
EndDo;
EndIf;
EndDo;
*INLR = '1';
//****************************************************************
Dcl-Proc CHNG;
Chain NAME FMT1;
*IN60 = not %Found;
If *IN60 = '0';
Exfmt CHANGE;
If *IN03 = '0';
Update FMT1;
Else;
*IN03 = '0';
EndIf;
EndIf;
End-Proc CHNG;
//****************************************************************
Dcl-Proc DISP;
Chain NAME FMT1;
*IN60 = not %Found;
If *IN60 = '0';
Exfmt DISPLAY;
*IN03 = '0';
EndIf;
End-Proc DISP;
Compile using CRTBNDRPG PGM(<yourlib>/SFLRCDSEL2) SRCFILE(<yourlib>/QRPGLESRC) SRCMBR(SFLRCDSEL2) DFTACTGRP(*NO)
CALL <yourlib>/SFLRCDSEL2
[{"Type":"MASTER","Line of Business":{"code":"LOB68","label":"Power HW"},"Business Unit":{"code":"BU070","label":"IBM Infrastructure"},"Product":{"code":"SWG60","label":"IBM i"},"ARM Category":[{"code":"a8m0z0000000CHtAAM","label":"Programming ILE Languages"}],"ARM Case Number":"","Platform":[{"code":"PF012","label":"IBM i"}],"Version":"All Versions"}]
Historical Number
8402423
Was this topic helpful?
Document Information
Modified date:
07 November 2024
UID
nas8N1010160