ecki/IBM-i-RPG-Free-CLP-Code
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Initial Add *

Browse Source
This commit is contained in:
SJLennon 2021-04-20 12:23:10 -04:00
parent fb82bdd0bb
commit f42995b70b
10 changed files with 318 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
5250_Subfile/README.md
View File

@ -1,23 +1,22 @@
## 5250 Subfile: Full Screen and Windows
(__Under Construction__)
# 5250 Subfile: Full Screen and Windows
This is a working application that allows display, selection and maintenance of a customer master. The screens are _similar_ to what you see in PDM. The code is modular and there are several programs that can be called from multiple places. SQL is used for all database IO. There are "page at a time" subfiles (full screen and in a window) and a "load all" subfile in a window. The windows show a couple of border styles.
### Sample Inquiry Screens
## Sample Inquiry Screens
![Inquiry Subfile](Images/Inquiry_Subfile.png)
![Inquiry Subfile](Images/Inquiry_Display.png)
### Sample Maintenance Screen
## Sample Maintenance Screen
![Inquiry Subfile](Images/Maintenance_Display.png)
### Prompting to Select a State
## Prompting to Select a State
![State Prompt](Images/State_Prompt.png)
#### General Notes
## General Notes
Some of the programs use /Include statements, which are found in the Copy_Mbrs directory. In the code these programs refer to my DEMO library, so to compile you may need to change this.
@ -29,10 +28,10 @@ The style tries to have consistent naming and I do not share field names between
The display file uses a private set of indicators, something I started doing to try to educate coworkers who were struggling with monolithic code where all 99 indicators were in use. You can also reset indicators and such in display files, but I prefer to do it myself.
#### PMTCUSTR/PMTCUSTD
### PMTCUSTR/PMTCUSTD
RPG program that puts up a 5250 subfile that allows searching by customer name, city and state. Display of Inactive records can be toggled using F9.
There are 3 functions, or modes, controlled by the first parameter passsed: Inquiry to display a record; Maintenance to change a record; Selection to return a customer id.
- I gives 5=Display
@ -42,17 +41,17 @@ The display file uses a private set of indicators, something I started doing to
Conceptually, you can call this program from almost anywhere and control access to it by whatever menuing or security system you have in place. The general user population would progably get Inquiry and Sales would have Maintenance. Selection could be used for any in-house program that needed to prompt for a customer id number.
#### MTNCUSTR/MTNCUSTD
### MTNCUSTR/MTNCUSTD
RPG program that maintains a customer. Customer id is provided as the first parameter. It also adds or displays a customer. Function is controlled by the second parameter. It is called from PMTCUSTR, but it could be called from any program that has a customer id available, or which needs to add a customer.
If the cursor is in a field with a + in the field name (ST+ here) you can press F4 to prompt the field.
The window has the default border, which may vary depending on which 5250 emulator you are using. The sample is using the iACS emulator from IBM.
The window has the default border, which may vary depending on which 5250 emulator you are using. The sample is using the iACS emulator from IBM.
### PMTSTATER/PMTSTATED
RPG program and window display file to prompt for a USA state code. Called when F4 is used in PMTCUSTR or MTNCUSTR. Display can be sequenced by either state name or 2-character code, toggled by F7.
RPG program and window display file to prompt for a USA state code. Called when F4 is used in PMTCUSTR or MTNCUSTR. Display can be sequenced by either state name or 2-character code, toggled by F7.
Strictly speaking, this is more of a demonstration program that may, or may not, have a lot of practical value in real life.
@ -75,5 +74,3 @@ The window has a blue border of reverse image blanks. This will display consiste
### States.SQL
SQL Code to create and populate the STATES table, which is a table of USA state names and their 2-character abbreviations.

5
BASE36/BASE36_P.RPGLE Normal file
View File

@ -0,0 +1,5 @@
**FREE
// === BASE36ADD prototype ==========================================
dcl-pr BASE36ADD varchar(50);
theValue varchar(50) const;
end-pr;

79
BASE36/BTBR.SQLRPGLE Normal file
View File

@ -0,0 +1,79 @@
**FREE
//====================================================================
// Test program to exercise BASE36ADD in batch.
// Result values are written out to table BTB.
// Call with two parameters:
// 1) Starting value to increment, e.g. '988'
// 2) Ending value, e.g. '992'
// Examples:
// CALL PGM(BTBR) PARM('988' '992')
// Should write 31 records.
// CALL PGM(BTBR) PARM('1B999999999999999998' '1CAAAAAAAAAAAAAAAAAD')
// Should write 6 records.
// SQL error checking is functional but it is not production
// quality. Do not copy!
//====================================================================
ctl-opt debug option(*nodebugio: *srcstmt) dftactgrp(*no)
actgrp(*caller) bnddir('SRV_BASE36')
main(Main);
/include base36,base36_p
dcl-proc Main ;
dcl-pi *N extpgm('BTBR');
pi_First char(20);
pi_Last char(20);
end-pi;
dcl-s wkNext varchar(50);
dcl-s wkLast varchar(50);
dcl-s count int(10) inz(0);
dcl-s msg char(52);
*inlr = *on;
exec sql set option
datfmt=*iso,
closqlcsr=*endmod,
commit=*none
;
//=== Convert input parms to varchar ================================
wkNext = %trim(pi_First);
wkLast = %trim(pi_Last);
//=== Drop and recreate output Table =================================
exec sql set schema lennons1; // <----- Change this to your library!
exec sql drop table btb;
exec sql create table btb (
theSeq int,
theValue varchar(50),
constraint value_primary primary key( theValue )
);
if SQLSTATE <> '00000' and SQLSTATE <> '01567';
dsply 'Create Table failed';
return;
endif;
exec sql alter table btb
add constraint seq_unique unique( theSeq )
;
if SQLSTATE <> '00000';
dsply 'Alter Table failed';
return;
endif;
//=== Run the Test ===================================================
dow wkNext <= wkLast;
wkNext = BASE36ADD(wkNext);
count += 1;
exec sql insert into btb values (:count, :wkNext);
if SQLSTATE <> '00000';
dsply 'Insert failed';
count -= 1;
leave;
endif;
enddo;
msg = 'Records written: ' +%char(count);
dsply msg;
return;
end-proc;

60
BASE36/BTID.DSPF Normal file
View File

@ -0,0 +1,60 @@
A*===============================================================
A DSPSIZ(24 80 *DS3)
A PRINT
A INDARA
A CF04
A CA05
A CA03
A*===============================================================
A R SCREEN
A TEXT('Screen Header')
A SH_PGM 10A O 1 2
A 1 21'Test BASE36ADD'
A 1 47DATE
A EDTCDE(Y)
A 2 1USER
A 2 47TIME
A*---------------------------------------------------------------
A 3 30'<-Rolling Value(s)'
A 4 30'<-'
A 5 30'<-'
A 6 30'<-'
A 7 30'<-'
A 8 30'<-'
A 9 30'<-'
A 10 30'<-'
A 11 30'<-'
A 12 30'<-'
A 13 30'<-'
A 14 30'<-'
A 15 30'<-'
A 16 30'<-'
A 17 30'<-'
A 18 30'<-'
A 19 30'<-'
A 20 30'<-Rolling Value(s)'
A VAL1 20A O 3 1
A VAL2 20A O 4 1
A VAL3 20A O 5 1
A VAL4 20A O 6 1
A VAL5 20A O 7 1
A VAL6 20A O 8 1
A VAL7 20A O 9 1
A VAL8 20A O 10 1
A VAL9 20A O 11 1
A VAL10 20A O 12 1
A VAL11 20A O 13 1
A VAL12 20A O 14 1
A VAL13 20A O 15 1
A VAL14 20A O 16 1
A VAL15 20A O 17 1
A VAL16 20A O 18 1
A VAL17 20A O 19 1
A VAL18 20A O 20 1
A VAL 20A B 21 1
A 21 30'Value'
A N40 21 38'<- Enter a starting Value'
A 40 22 30'Press enter to add 1 to value'
A 40 23 30'F5 to enter new Value'
A 24 30'F3 to EXIT'

90
BASE36/BTIR.RPGLE Normal file
View File

@ -0,0 +1,90 @@
**FREE
//====================================================================
// Interactive program to demonstrate/exercise BASE36ADD.
// Enter a value up to 20 characters. Press enter and the value + 1
// is displayed. Each enter increments by 1 and the values roll
// up the screen.
// Not a lot of error checking. You can see what happens if you
// enter a character that is not A-Z or 0-9.
//====================================================================
ctl-opt debug option(*nodebugio: *srcstmt) dftactgrp(*no)
actgrp(*caller) bnddir('SRV_BASE36')
main(Main);
/include base36,base36_p
dcl-f BTID WORKSTN INFDS(dfInfDS) Usropn;
dcl-ds dfInfDS;
Key char(1) pos(369);
end-ds;
dcl-c F03 x'33';
dcl-c F05 x'35';
dcl-s ValVar varchar(20);
dcl-s j int(10);
dcl-ds *N; // Rolling screen fields
Val1;
Val2;
Val3;
Val4;
val5;
val6;
val7;
val8;
val9;
val10;
val11;
val12;
val13;
val14;
val15;
val16;
val17;
val18;
Values char(20) dim(18) pos(1);
end-ds;
dcl-proc Main ;
if not %open(BTID);
open BTID;
endif;
exsr GetVal;
dow Key <> F03;
*in40 = *on;
if Key = F05;
exsr GetVal;
iter;
endif;
// Roll values up the screen
for j = 1 to %elem(Values)-1;
Values(j) = Values(J+1);
endfor;
Val18 = Val;
// Increment by 1
valVar = %trim(val);
valVar = BASE36ADD(ValVar);
Val = ValVar;
exfmt SCREEN;
enddo;
close BTID;
*inlr=*on;
// Get the starting value
begsr GetVal;
*in40 = *off;
Values = *blanks;
dou Val <> *blanks;
exfmt SCREEN;
if Key = F03;
return;
endif;
enddo;
endsr;
end-proc;

8
BASE36/CRTBNDDIR.CLLE Normal file
View File

@ -0,0 +1,8 @@
PGM
/* Create UTIL_BND binding directory in *CURLIB */
/* Change next statement if needed */
CRTBNDDIR BNDDIR(*CURLIB/SRV_BASE36) TEXT('BASE36 ADD +
Service PGMs')
ADDBNDDIRE BNDDIR(SRV_BASE36) OBJ((SRV_BASE36 *SRVPGM +
*DEFER))
ENDPGM

BIN
BASE36/Images/BTIR_1.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 10 KiB

BIN
BASE36/Images/BTIR_2.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 14 KiB

55
BASE36/SRV_BASE36.RPGLE Normal file
View File

@ -0,0 +1,55 @@
**FREE
// ====================================================================
// Contains BASE36ADD procedure to increments by 1 a Character value.
// Pass in a value and it returns the value incremtented by 1.
// ====================================================================
// - It works on any string length up to an arbitrary 50 characters.
// So the value must be passed in as varying character and the
// incremented value is returned as varying character.
// - It is the callers responsibility to ensure that if the absolute
// maximum value is returned then some action must be taken to
// report/handle the situation where no more values are available.
// If called with the maximum value it will roll over to the minimum
// value. E.g., call with 999 and AAA will be returned.
// - This code is based on the 36 character set A-Z and 0-9.
// - As coded, the sequence of the values follows the EBCDIC raw
// sorting sequence.
// - If a different character set is needed, e.g., you wish to omit
// O and L because they look to much like 0 and 1, simply
// remove them from the "From" and "To" strings.
//
// 1) CRTRPGMOD MODULE(SRV_BASE36)
// 2) CRTSRVPGM SRVPGM(SRV_BASE36) EXPORT(*ALL) TEXT('BASE36 Service Pgm')
// 3) ADDBNDDIRE BNDDIR(SRV_BASE36) OBJ((SRV_BASE36 *SRVPGM *DEFER))
ctl-opt debug nomain option(*nodebugio: *srcstmt) ;
/include BASE36,BASE36_P
dcl-proc BASE36ADD export ;
dcl-pi BASE36ADD varchar(50);
PI_Value varchar(50) const; // Input value
end-pi BASE36ADD;
dcl-s wkValue like(PI_Value);
dcl-s inx int(10);
// Ascending values of a postion is A,B,...,Y,Z,0,1,2,...,7,8,9.
dcl-c From 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789';
dcl-c To 'BCDEFGHIJKLMNOPQRSTUVWXYZ0123456789A';
wkValue = PI_Value;
// Increment the last position in the input value. If it now is
// equal to the last character in "To" then it has rolled over,
// so move to the prior input value field and repeat.
inx = %len(PI_Value);
dow inx > 0;
%subst(wkValue:inx:1) = %xlate(From:To:%subst(wkValue:inx:1));
// if %subst(wkValue:inx:1) <> 'A'; // Not rolled over
if %subst(wkValue:inx:1) <> %subst(To:%size(To):1) ; // Not rolled over
leave;
endif;
inx -= 1;
enddo;
return wkValue; // return incremented value
end-proc BASE36ADD;

15
README.md
View File

@ -1,7 +1,8 @@
# IBM i RPG/Free CLP Code
Demo code in RPG/Free, SQL and CLP for the IBM i
More developers are learning about the **IBM i** as a wonderful business platform. ( It was formerly known as the **AS/400**.)
Demo code in RPG/Free, SQL and CLP for the IBM i
More developers are learning about the **IBM i** as a wonderful business platform. ( It was formerly known as the **AS/400**.)
My intent is to provide real programs that help you learn, or improve your current understanding, and which you can adapt to you needs.
@ -19,6 +20,10 @@ Utility support routines that are called from other code.
Batch program with SQL embedded in RPGLE. Includes error checking and handling. There are two versions, one in completely free format and one not free with the D-Specs in fixed format.
## 5250 Subfile
## 5250 Subfile
Many shops are still using 5250 "green screen" applications and these need to be maintained and/or extended. This is a fully functional modernized 5250 "green screen" Customer Master maintenance and prompting application, with full screen and window displays, modular code, service programs, message files and a sample database.
Many shops are still using 5250 "green screen" applications and these need to be maintained and/or extended. This is a fully functional modernized 5250 "green screen" Customer Master maintenance and prompting application, with full screen and window displays, modular code, service programs, message files and a sample database.
## BASE36
A service program to add 1 to an alpha-numeric string of any length.