USADRVAL Initial Add
This commit is contained in:
SJLennon
@@ -17,3 +17,11 @@ These are source files that will be copied into programs using /COPY or /INCLUDE
|
||||
* SRV_SQL_P
|
||||
|
||||
Prorotype definitions for procedures in the SQL_SRV service program.
|
||||
|
||||
* USADRVAL_P
|
||||
|
||||
Prototype for the USADRVAL service program.
|
||||
|
||||
* USADRVALDS
|
||||
|
||||
Template Data Structure for the USADRVAL parameters.
|
||||
|
||||
@@ -50,6 +50,11 @@ Commands, CLLE, SQLRPGLE using SQL access to APIs.
|
||||
|
||||
Sets up group jobs suitable for an IBM i developer.
|
||||
|
||||
## USPS_Address
|
||||
|
||||
SQL QSYS2.HTTP_GET call to the US Post Office webtools API AddressValidateRequest.
|
||||
RPG service program to call the API and parse the returned XML.
|
||||
|
||||
## Utils
|
||||
|
||||
Developer Utilities.
|
||||
|
||||
@@ -0,0 +1,8 @@
|
||||
PGM
|
||||
/* Create ADRVAL_BND binding directory in *CURLIB */
|
||||
/* Change next statement if needed */
|
||||
CRTBNDDIR BNDDIR(*CURLIB/ADRVAL_BND) TEXT('USADRVAL +
|
||||
Service PGM')
|
||||
ADDBNDDIRE BNDDIR(ADRVAL_BND) OBJ((USADRVAL *SRVPGM +
|
||||
*DEFER))
|
||||
ENDPGM
|
||||
@@ -0,0 +1,194 @@
|
||||
A*===============================================================
|
||||
A* Window to display or update Customer Master
|
||||
A*===============================================================
|
||||
A* CRTDSPF FILE(MTNCUSTD) SRCFILE(...) RSTDSP(*YES)
|
||||
A*==============================================================
|
||||
A* There is a naming convention for the fields in each record.
|
||||
A* -- Screen Header: Fields begin with SH_
|
||||
A* -- Details Fields begin with SD_
|
||||
A* -- Screen footer: Fields begin with SFT_
|
||||
A*===============================================================
|
||||
A* Indicator usage:
|
||||
A* 01-20 Are not routinely cleared after an EXFMT. Some
|
||||
A* of these are used in subfile & subfile control for
|
||||
A* highlighting, etc., which does not change unless
|
||||
A* explicitly requested.
|
||||
A* 21-99 Are routinely cleared after an EXFMT.
|
||||
A* 80-89 Subfile record
|
||||
A* 90 Nessage Subfile end
|
||||
A* 91-99 Subfile Control Record
|
||||
A* Note: INDARA is specified here and in the program and this
|
||||
A* means that the display file indicators are in a
|
||||
A* means that the display file indicators are in a
|
||||
A* data structure separate from the program indicators.
|
||||
A* This makes it easy to name the indicators in the DS.
|
||||
a* Note: DSPATR HI and RI at the same time = non-display. Thus
|
||||
a* when we turn on RI were turn of HI,
|
||||
a* 01/2021 Lennon Allow lower case on name, address, city
|
||||
A*===============================================================
|
||||
A*%%EC
|
||||
A DSPSIZ(24 80 *DS3)
|
||||
A PRINT
|
||||
A INDARA
|
||||
A ALTHELP
|
||||
A CF04
|
||||
A CA05
|
||||
A CA12
|
||||
A HELP
|
||||
A*===============================================================
|
||||
A*=== Screen Header: Fields begin with SH_ =====================
|
||||
A*
|
||||
A R SH_HDR
|
||||
A OVERLAY
|
||||
A TEXT('Screen Header')
|
||||
A WDWBORDER((*COLOR PNK))
|
||||
A WINDOW(*DFT 17 54)
|
||||
A SH_PGM 10A O 1 1
|
||||
A 1 21'Customer Master'
|
||||
A 1 47DATE
|
||||
A EDTCDE(Y)
|
||||
A 2 1USER
|
||||
A SH_FUNCT 25A O 2 16DSPATR(HI)
|
||||
A 2 47TIME
|
||||
A*===============================================================
|
||||
A*=== Data Details - Fields begin with SD_ ======================
|
||||
A R DETAILS
|
||||
A OVERLAY
|
||||
A WINDOW(SH_HDR)
|
||||
A CHGINPDFT
|
||||
A RTNCSRLOC(&SD_PMT_RCD &SD_PMT_FLD)
|
||||
A*---------------------------------------------------------------
|
||||
A 5 1'Customer Id'
|
||||
A SD_CUSTID 4 0 5 14DSPATR(HI)
|
||||
A 5 20'Active Status'
|
||||
A SD_ACTIVE 1 B 5 35
|
||||
A N40 DSPATR(HI)
|
||||
A 40 DSPATR(RI)
|
||||
A 41 DSPATR(PC)
|
||||
A 10 DSPATR(PR)
|
||||
A N10 DSPATR(UL)
|
||||
A 6 1'Name'
|
||||
A SD_NAME 40 B 6 9CHECK(LC)
|
||||
A N42 DSPATR(HI)
|
||||
A 42 DSPATR(RI)
|
||||
A 43 DSPATR(PC)
|
||||
A 10 DSPATR(PR)
|
||||
A N10 DSPATR(UL)
|
||||
A 7 1'Address'
|
||||
A SD_ADDR 40 B 7 9CHECK(LC)
|
||||
A N44 DSPATR(HI)
|
||||
A 44 DSPATR(RI)
|
||||
A 45 DSPATR(PC)
|
||||
A 10 DSPATR(PR)
|
||||
A N10 DSPATR(UL)
|
||||
A 8 1'City'
|
||||
A SD_CITY 20 B 8 9CHECK(LC)
|
||||
A N46 DSPATR(HI)
|
||||
A 46 DSPATR(RI)
|
||||
A 47 DSPATR(PC)
|
||||
A 10 DSPATR(PR)
|
||||
A N10 DSPATR(UL)
|
||||
A 8 32'ST+'
|
||||
A SD_STATE 2 B 8 36
|
||||
A N48 DSPATR(HI)
|
||||
A 48 DSPATR(RI)
|
||||
A 49 DSPATR(PC)
|
||||
A 10 DSPATR(PR)
|
||||
A N10 DSPATR(UL)
|
||||
A 8 39'ZIP'
|
||||
A SD_ZIP 10 B 8 43
|
||||
A N50 DSPATR(HI)
|
||||
A 50 DSPATR(RI)
|
||||
A 51 DSPATR(PC)
|
||||
A 10 DSPATR(PR)
|
||||
A N10 DSPATR(UL)
|
||||
A 9 1'Account Manager'
|
||||
A 10 5'Phone'
|
||||
A SD_ACCTPH 20 B 10 15
|
||||
A N52 DSPATR(HI)
|
||||
A 52 DSPATR(RI)
|
||||
A 53 DSPATR(PC)
|
||||
A 10 DSPATR(PR)
|
||||
A N10 DSPATR(UL)
|
||||
A 11 5'Name'
|
||||
A SD_ACCTMGR 40 B 11 15CHECK(LC)
|
||||
A N54 DSPATR(HI)
|
||||
A 54 DSPATR(RI)
|
||||
A 55 DSPATR(PC)
|
||||
A 10 DSPATR(PR)
|
||||
A N10 DSPATR(UL)
|
||||
A 12 1'Corporate Phone'
|
||||
A SD_CORPPH 20 B 12 17
|
||||
A N56 DSPATR(HI)
|
||||
A 56 DSPATR(RI)
|
||||
A 57 DSPATR(PC)
|
||||
A 10 DSPATR(PR)
|
||||
A N10 DSPATR(UL)
|
||||
A 13 1'Last Change'
|
||||
A N61 DSPATR(ND)
|
||||
A SD_CHGTIME 23 13 13
|
||||
A N61 DSPATR(ND)
|
||||
A 13 37'by'
|
||||
A N61 DSPATR(ND)
|
||||
A SD_CHGUSER 15 13 40
|
||||
A N61 DSPATR(ND)
|
||||
A SD_PMT_RCD 10A H
|
||||
A SD_PMT_FLD 10A H
|
||||
A*===============================================================
|
||||
A*=== Screen footer & function keys: Fields begin with SFT_ ====
|
||||
A*
|
||||
A R SFT_FKEY
|
||||
A TEXT('Screen Footer')
|
||||
A OVERLAY
|
||||
A WINDOW(SH_HDR)
|
||||
A 14 1' Demo Corp of America -
|
||||
A '
|
||||
A DSPATR(UL)
|
||||
A SFT_KEYS 53A O 15 1COLOR(BLU)
|
||||
A*===============================================================
|
||||
A*=== Message Subfile: No fields ===============================
|
||||
A*
|
||||
A R MSGSFL SFL
|
||||
A TEXT('Message Subfile')
|
||||
A SFLMSGRCD(16)
|
||||
A MSGKEY SFLMSGKEY
|
||||
A MSGPGMQ SFLPGMQ(10)
|
||||
A*===============================================================
|
||||
A*=== Message Subfile Control: No fields ========================
|
||||
A*
|
||||
A R MSGCTL SFLCTL(MSGSFL)
|
||||
A TEXT('Message Subfile Control')
|
||||
A WINDOW(SH_HDR)
|
||||
A PAGEDOWN
|
||||
A PAGEUP
|
||||
A OVERLAY
|
||||
A SFLDSP
|
||||
A SFLDSPCTL
|
||||
A SFLINZ
|
||||
A N90 SFLEND
|
||||
A SFLSIZ(0002)
|
||||
A SFLPAG(0001)
|
||||
A MSGPGMQ SFLPGMQ(10)
|
||||
A*===============================================================
|
||||
A*=== Dummy Record - Assume =====================================
|
||||
A*
|
||||
A R DUMMY
|
||||
A ASSUME
|
||||
A KEEP
|
||||
A 1 2'*'
|
||||
A*%%RS+<record-sequences>
|
||||
A*%%RS+ <sequence name="SCREEN1">
|
||||
A*%%RS+ <device type="display" width="80" height="24" />
|
||||
A*%%RS+ <record-write record-format="SH_HDR" />
|
||||
A*%%RS+ <record-write record-format="DETAILS" />
|
||||
A*%%RS+ <record-write record-format="SFT_FKEY" />
|
||||
A*%%RS+ <record-write record-format="MSGSFL" />
|
||||
A*%%RS+ <record-write record-format="MSGCTL" />
|
||||
A*%%RS+ <record-write record-format="DUMMY" />
|
||||
A*%%RS+ </sequence>
|
||||
A*%%RS </record-sequences>
|
||||
A*%%RS+<record-sequences>
|
||||
A*%%RS+ <sequence name="Untitled">
|
||||
A*%%RS+ <device type="display" width="80" height="24" />
|
||||
A*%%RS+ </sequence>
|
||||
A*%%RS </record-sequences>
|
||||
@@ -0,0 +1,860 @@
|
||||
**FREE
|
||||
/TITLE MNTCUSTR - Update/Display a Customer Master
|
||||
//==============================================================
|
||||
// A maintenance or display program for a Customer Master Recds
|
||||
//
|
||||
//
|
||||
// Parameters
|
||||
// ----------
|
||||
// 1 In Z4 Customer Id to, or 0 to add a new code
|
||||
// 2 In CL1 Function
|
||||
// E - Edit passed record
|
||||
// D - Display passed record
|
||||
// A - Add a new record
|
||||
//
|
||||
// If no parms passed, close the display file and return.
|
||||
//==============================================================
|
||||
// Program is essentially without indicators. (Indicators are
|
||||
// stil lneeded to control the display file, but all have names.)
|
||||
//
|
||||
// Naming Conventions
|
||||
// ==================
|
||||
// - Lower case is the default for opcodes.
|
||||
// - TitleCase is used for program variables, subroutines and procedure
|
||||
// names, e.g. MaxOrderQty, BldFkeyText, etc.
|
||||
// - Temporary variables are prefixed with "wk", e.g., wkDate. Such
|
||||
// variables contain valid data for only a short time and are never
|
||||
// carried across subroutines.
|
||||
// - UPPERCASE is used for external names, i.e., files, fields, formats
|
||||
// and anything else not directly coded in the program.
|
||||
//
|
||||
// - In the display file, this screen field naming convention is used:
|
||||
// Screen Header: Fields begin with SH_
|
||||
// Detail Fields begin with SD_
|
||||
// Screen footer: Fields begin with SFT_
|
||||
//==============================================================
|
||||
// Compilation
|
||||
// Use CRTSQLRPGI command.
|
||||
// Note that /INCLUDEs expects to find code in DEMO library,
|
||||
// not the default of QRPGLESRC. Change as needed.
|
||||
//=============================================================
|
||||
|
||||
ctl-opt dftactgrp(*no) actgrp(*caller) option(*nodebugio: *srcstmt)
|
||||
bnddir('UTIL_BND':'ADRVAL_BND') main(main);
|
||||
|
||||
//=== Display File =============================================
|
||||
dcl-f MTNCUSTD workstn infds(dfinfds) indds(dfindds) usropn;
|
||||
|
||||
//=== Service Program Prototypes ===============================
|
||||
/include copy_mbrs,Srv_Msg_P
|
||||
/include copy_mbrs,Srv_Str_P
|
||||
/include usps,USAdrVal_p
|
||||
|
||||
//=== Named hexadecimal constants for function keys ============
|
||||
/include copy_mbrs,##AIDBYTES
|
||||
|
||||
//=== USAdrVal Paramter DS ======================================
|
||||
/include usps,USAdrvalDS
|
||||
dcl-ds AdrIn likeds (USAdrValDS);
|
||||
dcl-ds AdrOut likeds (USAdrValDS);
|
||||
|
||||
//=== Fields read by SQL ========================================
|
||||
// NOTE: Only the fields in the SQL statement are populated!
|
||||
dcl-ds CUSTMAST extname('CUSTMAST') end-ds;
|
||||
|
||||
//=== SQL State Constants ======================================
|
||||
dcl-c SQLSUCCESS '00000';
|
||||
dcl-c SQLNODATA '02000';
|
||||
dcl-c SQLNOMOREDATA '02000';
|
||||
dcl-c SQLDUPRECD '23505';
|
||||
dcl-c SQLROWLOCKED '57033';
|
||||
|
||||
//=== Display File Information Data Structure ==================
|
||||
// Allows us to determine which function key was pressed
|
||||
dcl-ds dfInfDS;
|
||||
Key char(1) pos(369);
|
||||
end-ds;
|
||||
|
||||
//=== Display File Indicator Data Structure ====================
|
||||
// This is a "private" indicator area for the display file.
|
||||
|
||||
//--- 01-20 are not automatically cleared after EXFMT ----------
|
||||
dcl-ds dfIndDS len(99);
|
||||
|
||||
//--- 21-99 are automatically cleared after EXFMT --------------
|
||||
Protect_SD_ALL ind pos(10);
|
||||
dfIndClr char(79) pos(21);
|
||||
RI_SD_ACTIVE ind pos(40);
|
||||
PC_SD_ACTIVE ind pos(41);
|
||||
RI_SD_NAME ind pos(42);
|
||||
PC_SD_NAME ind pos(43);
|
||||
RI_SD_ADDR ind pos(44);
|
||||
PC_SD_ADDR ind pos(45);
|
||||
RI_SD_CITY ind pos(46);
|
||||
PC_SD_CITY ind pos(47);
|
||||
RI_SD_STATE ind pos(48);
|
||||
PC_SD_STATE ind pos(49);
|
||||
RI_SD_ZIP ind pos(50);
|
||||
PC_SD_ZIP ind pos(51);
|
||||
RI_SD_ACCTPH ind pos(52);
|
||||
PC_SD_ACCTPH ind pos(53);
|
||||
RI_SD_ACCTMGR ind pos(54);
|
||||
PC_SD_ACCTMGR ind pos(55);
|
||||
RI_SD_CORPPH ind pos(56);
|
||||
PC_SD_CORPPH ind pos(57);
|
||||
DSP_SD_STAMP ind pos(61);
|
||||
end-ds;
|
||||
|
||||
//=== Screen Header Text =======================================
|
||||
dcl-s H2TextE like(sh_funct) inz('Change Customer');
|
||||
dcl-s H2TextA like(sh_funct) inz('Add Customer');
|
||||
dcl-s H2TextD like(sh_funct) inz('Displaying Customer');
|
||||
|
||||
//=== Text for function keys ===================================
|
||||
dcl-c F3TEXT 'F3=Exit';
|
||||
dcl-c F4TEXT 'F4=Prompt+';
|
||||
dcl-c F5TEXT 'F5=Refresh';
|
||||
dcl-c F12TEXT 'F12=Cancel';
|
||||
|
||||
//=== External Programs Prototypes =============================
|
||||
dcl-pr PmtState extpgm('PMTSTATER');
|
||||
*n like(state); // TheState
|
||||
end-pr;
|
||||
//=== Global Switches ==========================================
|
||||
dcl-c COWSCOMEHOME const('0');
|
||||
dcl-c DISPLAYING const('D');
|
||||
dcl-c EDITING const('E');
|
||||
dcl-c ADDING const('A');
|
||||
|
||||
dcl-s SflMsgSnt ind;
|
||||
dcl-s Function char(1);
|
||||
dcl-s NoErrors ind;
|
||||
|
||||
// === Global Fields ===========================================
|
||||
dcl-s Orig_CHGTIME timestamp;
|
||||
|
||||
//=== Work Fields ==============================================
|
||||
dcl-s wkInt int(10);
|
||||
dcl-s wkMsgText varchar(256);
|
||||
|
||||
// === Next available customer number ==========================
|
||||
dcl-s Cust_Next packed(4) dtaara('CUSTNEXT');
|
||||
|
||||
//=== Program Status Data Structure ============================
|
||||
dcl-ds ProgStatus PSDS;
|
||||
PgmName *PROC;
|
||||
CURR_USER char(10) pos(358); // * Current user
|
||||
end-ds;
|
||||
|
||||
dcl-s MainProc char(10);
|
||||
|
||||
//==============================================================
|
||||
//==============================================================
|
||||
// === Program Starts Here =====================================
|
||||
//==============================================================
|
||||
|
||||
dcl-proc Main;
|
||||
dcl-pi Main;
|
||||
pID like(custid);
|
||||
pMaintain char(1);
|
||||
end-pi;
|
||||
|
||||
|
||||
//=== Set SQL Options ===============================
|
||||
exec sql set option datfmt=*iso,
|
||||
closqlcsr=*endmod,
|
||||
commit = *NONE;
|
||||
|
||||
//=== Initialization Logic ===================================
|
||||
exsr Init;
|
||||
|
||||
//--- Establish window that other formats refer to ---
|
||||
write SH_HDR;
|
||||
|
||||
//============================================================
|
||||
// === Main Program Loop =====================================
|
||||
//============================================================
|
||||
// Loops until logic decides to exit.
|
||||
dou (COWSCOMEHOME);
|
||||
select;
|
||||
// =======================================================
|
||||
// === DISPLAYING an existing Customer ===================
|
||||
// =======================================================
|
||||
when ( Function = DISPLAYING);
|
||||
exsr ReadRecd;
|
||||
if (SQLSTT = SQLNODATA);
|
||||
SQLProblem('Calling error 1: Code passed in does not exist.');
|
||||
endif;
|
||||
exsr FillScreenFields;
|
||||
// All Fields protected
|
||||
exsr ProtectAll;
|
||||
exsr ScreenIO;
|
||||
exsr CloseDownPgm;
|
||||
return;
|
||||
|
||||
// =======================================================
|
||||
// === Updating an existing Customer =====================
|
||||
// =======================================================
|
||||
when (Function = EDITING);
|
||||
exsr ReadRecd;
|
||||
if (SQLSTT = SQLNODATA);
|
||||
SQLProblem('Calling error 2: Code passed in does not exist.');
|
||||
endif;
|
||||
exsr FillScreenFields;
|
||||
|
||||
// Write/read screen until all data is valid,
|
||||
// then re-display for confirmation to update.
|
||||
dou (NoErrors);
|
||||
exsr ScreenIO;
|
||||
select;
|
||||
|
||||
when (Key = F12);
|
||||
exsr CloseDownPgm;
|
||||
return;
|
||||
|
||||
when (Key = F05);
|
||||
exsr ReadRecd;
|
||||
if (SQLSTT = SQLNODATA);
|
||||
// Record vanished!
|
||||
SflMsgSnt= SndSflMsg('DEM0599'); //Delete, redo search
|
||||
clear CUSTMAST;
|
||||
endif;
|
||||
NoErrors = *off;
|
||||
|
||||
when (Key = F04);
|
||||
exsr F04Prompt;
|
||||
|
||||
when (Key = Enter);
|
||||
exsr EditUpdData;
|
||||
if (NoErrors);
|
||||
// Re-display screen fields for confirmation
|
||||
exsr ProtectAll;
|
||||
exsr FillScreenFields;
|
||||
SflMsgSnt = SndSflMsg('DEM0000'); // Enter to update ...
|
||||
exsr ScreenIO;
|
||||
select;
|
||||
when (Key = F12 or Key = F05);
|
||||
// Loop again
|
||||
when (Key = Enter);
|
||||
exsr UpdateRecd;
|
||||
if (NoErrors);
|
||||
exsr CloseDownPgm; // Success! Exit program
|
||||
return;
|
||||
endif;
|
||||
other;
|
||||
SflMsgSnt = SndSflMsg('DEM0003'); // Key not active
|
||||
NoErrors = *off;
|
||||
endsl;
|
||||
endif;
|
||||
// Open up fields for correction of errors
|
||||
exsr UnProtectAll;
|
||||
|
||||
other;
|
||||
SflMsgSnt = SndSflMsg('DEM0003'); // Key not active
|
||||
NoErrors = *off; // Stay in dou NoErrors
|
||||
endsl;
|
||||
enddo;
|
||||
|
||||
// =======================================================
|
||||
// === Adding a new Customer =============================
|
||||
// =======================================================
|
||||
when ( Function=ADDING);
|
||||
clear CUSTMAST;
|
||||
//Default status to active
|
||||
ACTIVE = 'Y';
|
||||
exsr FillScreenFields;
|
||||
|
||||
dou (NoErrors);
|
||||
// Write/read screen until all data is valid,
|
||||
// then re-display for confirmation to update.
|
||||
//All fields can be keyed
|
||||
exsr UnProtectAll;
|
||||
exsr ScreenIO;
|
||||
select;
|
||||
when (Key = F12);
|
||||
exsr CloseDownPgm;
|
||||
return;
|
||||
|
||||
when (Key = F04);
|
||||
exsr F04Prompt;
|
||||
|
||||
when (Key = F05);
|
||||
clear CUSTMAST;
|
||||
ACTIVE = 'Y';
|
||||
exsr FillScreenFields;
|
||||
|
||||
when (Key = Enter);
|
||||
exsr EditAddData;
|
||||
if (NoErrors);
|
||||
// Re-display field for confirmation
|
||||
exsr ProtectAll;
|
||||
SflMsgSnt = SndSflMsg('DEM0009'); // Enter to add ...
|
||||
exsr FillScreenFields;
|
||||
exsr ScreenIO;
|
||||
select;
|
||||
when (Key=F12);
|
||||
exsr FillScreenFields;
|
||||
when (Key = Enter);
|
||||
exsr AddRecd;
|
||||
if (NoErrors);
|
||||
exsr CloseDownPgm;
|
||||
return;
|
||||
endif;
|
||||
other;
|
||||
SflMsgSnt = SndSflMsg('DEM0003'); // Key not active
|
||||
NoErrors = *off;
|
||||
endsl;
|
||||
endif;
|
||||
other;
|
||||
SflMsgSnt = SndSflMsg('DEM0003'); // Key not active
|
||||
endsl;
|
||||
enddo;
|
||||
|
||||
other;
|
||||
// =======================================================
|
||||
//=== Goofed - Should ever happen ========================
|
||||
// =======================================================
|
||||
dump(a);
|
||||
SflMsgSnt = SndSflMsg('DEM9999'); // Contact IT now ...
|
||||
return;
|
||||
endsl;
|
||||
|
||||
enddo;
|
||||
exsr CloseDownPgm; // Should never happen
|
||||
return;
|
||||
|
||||
//============================================================
|
||||
//=== End of Main Program Loop ===============================
|
||||
//============================================================
|
||||
return;
|
||||
|
||||
//=== ReadRecd ===============================================
|
||||
begsr ReadRecd;
|
||||
exec sql
|
||||
select
|
||||
CUSTID
|
||||
,NAME
|
||||
,ADDR
|
||||
,CITY
|
||||
,STATE
|
||||
,ZIP
|
||||
,CORPPHONE
|
||||
,ACCTMGR
|
||||
,ACCTPHONE
|
||||
,ACTIVE
|
||||
,CHGTIME
|
||||
,CHGUSER
|
||||
into :CUSTMAST
|
||||
from CUSTMAST
|
||||
where CUSTID = :pID
|
||||
;
|
||||
if (SQLSTT <> SQLSUCCESS and SQLSTT <> SQLNODATA);
|
||||
SQLProblem('ReadRecd');
|
||||
endif;
|
||||
Orig_CHGTIME = CHGTIME; // Save for update comparison
|
||||
endsr;
|
||||
|
||||
//=== FillScreenFields =======================================
|
||||
begsr FillScreenFields;
|
||||
SD_CUSTID = CUSTID;
|
||||
SD_NAME = NAME;
|
||||
SD_ADDR = ADDR;
|
||||
SD_CITY = CITY;
|
||||
SD_STATE = STATE;
|
||||
SD_ZIP = ZIP;
|
||||
SD_ACTIVE = ACTIVE;
|
||||
SD_ACCTPH = ACCTPHONE;
|
||||
SD_ACCTMGR =ACCTMGR;
|
||||
SD_CORPPH = CORPPHONE;
|
||||
SD_CHGTIME = ' ';
|
||||
SD_CHGUSER = ' ';
|
||||
// Show Changed stamp info
|
||||
if (CHGUSER <> '*SYSTEM*' and CHGUSER <> ' ');
|
||||
exec sql VALUES
|
||||
varchar_format(:CHGTIME, 'YYYY-Mon-DD')
|
||||
concat ' at ' concat
|
||||
varchar_format(:CHGTIME,'HH24:MI:SS')
|
||||
into :SD_CHGTIME;
|
||||
SD_CHGUSER = CHGUSER;
|
||||
DSP_SD_STAMP = *on;
|
||||
endif;
|
||||
endsr;
|
||||
|
||||
//=== F04Prompt ==============================================
|
||||
// CF04 reads the screen data. We then prompt and replace
|
||||
// anything in the state field, then we redisplay and
|
||||
// re-edit the screen data.
|
||||
// Always sets NoError to *off to force re-edit
|
||||
begsr F04Prompt;
|
||||
select;
|
||||
// --- Prompt for State Code
|
||||
when (SD_PMT_FLD = 'SD_STATE');
|
||||
PmtState(STATE);
|
||||
SD_STATE = STATE;
|
||||
PC_SD_STATE = *ON;
|
||||
// --- Field not promptable
|
||||
other;
|
||||
// Use F4 only in field followed by + sign
|
||||
SflMsgSnt= SndSflMsg('DEM0005');
|
||||
endsl;
|
||||
NoErrors = *off; // DOU Loop again
|
||||
endsr;
|
||||
|
||||
//=== EditUpdData ============================================
|
||||
// Edit the screen fields that can be changed on a update.
|
||||
// Give up when the first error found.
|
||||
// A valid screen field is moved to the database record.
|
||||
begsr EditUpdData;
|
||||
NoErrors = *on;
|
||||
|
||||
// ACTIVE Status
|
||||
exsr Edit_SD_ACTIVE;
|
||||
if (NoErrors = *off);
|
||||
leavesr;
|
||||
endif;
|
||||
// Name
|
||||
exsr Edit_SD_NAME;
|
||||
if (NoErrors = *off);
|
||||
leavesr;
|
||||
endif;
|
||||
// // Addr
|
||||
// exsr Edit_SD_ADDR;
|
||||
// if (NoErrors = *off);
|
||||
// leavesr;
|
||||
// endif;
|
||||
// // City
|
||||
// exsr Edit_SD_CITY;
|
||||
// if (NoErrors = *off);
|
||||
// leavesr;
|
||||
// endif;
|
||||
// // State
|
||||
// exsr Edit_SD_STATE;
|
||||
// if (NoErrors = *off);
|
||||
// leavesr;
|
||||
// endif;
|
||||
// // ZIP
|
||||
// exsr Edit_SD_ZIP;
|
||||
// if (NoErrors = *off);
|
||||
// leavesr;
|
||||
// endif;
|
||||
|
||||
// Account Phone
|
||||
exsr Edit_SD_ACCTPH;
|
||||
if (NoErrors = *off);
|
||||
leavesr;
|
||||
endif;
|
||||
// Account Manager
|
||||
exsr Edit_SD_ACCTMGR;
|
||||
if (NoErrors = *off);
|
||||
leavesr;
|
||||
endif;
|
||||
// Corporate Phone
|
||||
exsr Edit_SD_CORPPH;
|
||||
if (NoErrors = *off);
|
||||
leavesr;
|
||||
endif;
|
||||
// Address
|
||||
exsr Edit_Address;
|
||||
if (NoErrors = *off);
|
||||
leavesr;
|
||||
endif;
|
||||
endsr;
|
||||
|
||||
//=== EditAddData ============================================
|
||||
// Edit the screen fields needed to add a record.
|
||||
// Give up when the first error found.
|
||||
// A valid screen field is moved to the database record.
|
||||
begsr EditAddData;
|
||||
// For this program. same data for edit and add.
|
||||
exsr EditUpdData;
|
||||
endsr;
|
||||
|
||||
//=== Edit Address ===========================================
|
||||
begsr Edit_Address;
|
||||
clear AdrIn;
|
||||
AdrIn.Address2 = SD_ADDR;
|
||||
AdrIn.City = SD_CITY;
|
||||
AdrIn.State = SD_STATE;
|
||||
AdrIn.Zip5 = %subst(SD_ZIP :1 :5);
|
||||
|
||||
AdrOut = USAdrVal(AdrIn);
|
||||
// Good address-copy from USPS data & return
|
||||
if (AdrOut.City <> ' ');
|
||||
ADDR = AdrOut.Address2;
|
||||
CITY = AdrOut.City;
|
||||
STATE = AdrOut.State;
|
||||
if (AdrOut.Zip4 <> ' ');
|
||||
ZIP = AdrOut.Zip5 + '-' + AdrOut.Zip4;
|
||||
else;
|
||||
ZIP = AdrOut.Zip5;
|
||||
endif;
|
||||
leavesr;
|
||||
endif;
|
||||
// Bad address-send USPS error message
|
||||
SflMsgSnt = SndSflMsg('DEM9898' : AdrOut.Description);
|
||||
NoErrors = *off;
|
||||
PC_SD_ADDR = *ON;
|
||||
RI_SD_ADDR = *ON;
|
||||
RI_SD_CITY = *ON;
|
||||
RI_SD_STATE= *ON;
|
||||
RI_SD_ZIP= *ON;
|
||||
endsr;
|
||||
|
||||
//=== Edit_SD_ACTIVE==========================================
|
||||
begsr Edit_SD_ACTIVE;
|
||||
if (SD_ACTIVE = 'Y' or SD_ACTIVE = 'N');
|
||||
ACTIVE = SD_ACTIVE;
|
||||
leavesr;
|
||||
endif;
|
||||
SflMsgSnt = SndSflMsg('DEM0501': 'Active Status');
|
||||
NoErrors = *off;
|
||||
RI_SD_ACTIVE = *on;
|
||||
PC_SD_ACTIVE = *on;
|
||||
endsr;
|
||||
|
||||
//=== Edit_SD_NAME ===========================================
|
||||
begsr Edit_SD_NAME;
|
||||
if (SD_NAME <> ' ');
|
||||
NAME = SD_NAME;
|
||||
leavesr;
|
||||
endif;
|
||||
SflMsgSnt = SndSflMsg('DEM0502': 'Name');
|
||||
NoErrors= *off;
|
||||
RI_SD_NAME = *ON;
|
||||
PC_SD_NAME = *ON;
|
||||
endsr;
|
||||
|
||||
//=== Edit_SD_ADDR ===========================================
|
||||
begsr Edit_SD_ADDR;
|
||||
if (SD_ADDR <> ' ');
|
||||
ADDR = SD_ADDR;
|
||||
leavesr;
|
||||
endif;
|
||||
SflMsgSnt = SndSflMsg('DEM0502': 'Address');
|
||||
NoErrors= *off;
|
||||
RI_SD_ADDR = *ON;
|
||||
PC_SD_ADDR = *ON;
|
||||
endsr;
|
||||
|
||||
//=== Edit_SD_CITY ===========================================
|
||||
begsr Edit_SD_CITY;
|
||||
if (SD_CITY <> ' ');
|
||||
CITY = SD_CITY;
|
||||
leavesr;
|
||||
endif;
|
||||
SflMsgSnt = SndSflMsg('DEM0502': 'City');
|
||||
NoErrors= *off;
|
||||
RI_SD_CITY = *ON;
|
||||
PC_SD_CITY = *ON;
|
||||
endsr;
|
||||
|
||||
//=== Edit_SD_STATE ==========================================
|
||||
begsr Edit_SD_STATE;
|
||||
exec sql select STATE into :STATE
|
||||
from STATES
|
||||
where STATE = :SD_STATE;
|
||||
if (SQLSTT = SQLSUCCESS);
|
||||
STATE = SD_STATE;
|
||||
leavesr;
|
||||
endif;
|
||||
SflMsgSnt = SndSflMsg('DEM0503');
|
||||
NoErrors= *off;
|
||||
RI_SD_STATE= *ON;
|
||||
PC_SD_STATE = *ON;
|
||||
endsr;
|
||||
|
||||
//=== Edit_SD_ZIP ============================================
|
||||
begsr Edit_SD_ZIP;
|
||||
if (SD_ZIP <> ' ');
|
||||
ZIP = SD_ZIP;
|
||||
leavesr;
|
||||
endif;
|
||||
SflMsgSnt = SndSflMsg('DEM0502': 'ZIP');
|
||||
NoErrors= *off;
|
||||
RI_SD_ZIP= *ON;
|
||||
PC_SD_ZIP = *ON;
|
||||
endsr;
|
||||
|
||||
//=== Edit_SD_ACCTPH =========================================
|
||||
begsr Edit_SD_ACCTPH;
|
||||
if (SD_ACCTPH <> ' ');
|
||||
ACCTPHONE = SD_ACCTPH;
|
||||
leavesr;
|
||||
endif;
|
||||
SflMsgSnt = SndSflMsg('DEM0502': 'Account Manager Phone');
|
||||
NoErrors= *off;
|
||||
RI_SD_ACCTPH= *ON;
|
||||
PC_SD_ACCTPH = *ON;
|
||||
endsr;
|
||||
|
||||
//=== Edit_SD_ACCTMGR =========================================
|
||||
begsr Edit_SD_ACCTMGR;
|
||||
if (SD_ACCTMGR <> ' ');
|
||||
ACCTMGR = SD_ACCTMGR;
|
||||
leavesr;
|
||||
endif;
|
||||
SflMsgSnt = SndSflMsg('DEM0502': 'Account Manager Name');
|
||||
NoErrors= *off;
|
||||
RI_SD_ACCTMGR= *ON;
|
||||
PC_SD_ACCTMGR = *ON;
|
||||
endsr;
|
||||
|
||||
//=== Edit_SD_CORPPH =========================================
|
||||
begsr Edit_SD_CORPPH;
|
||||
if (SD_CORPPH <> ' ');
|
||||
CORPPHONE = SD_CORPPH;
|
||||
leavesr;
|
||||
endif;
|
||||
SflMsgSnt = SndSflMsg('DEM0502': 'Corporate Phone');
|
||||
NoErrors= *off;
|
||||
RI_SD_CORPPH= *ON;
|
||||
PC_SD_CORPPH = *ON;
|
||||
endsr;
|
||||
|
||||
//=== AddRecd ================================================
|
||||
// Insert a record into the file.
|
||||
// Returns: NoErrors = *on if the add was successful.
|
||||
begsr AddRecd;
|
||||
NoErrors = *on;
|
||||
in *LOCK Cust_Next;
|
||||
Cust_Next += 1;
|
||||
Out Cust_Next;
|
||||
CUSTID= Cust_Next;
|
||||
CHGTIME = %timestamp();
|
||||
CHGUSER = CURR_USER;
|
||||
exec sql
|
||||
insert into CUSTMAST
|
||||
values(:CUSTMAST)
|
||||
;
|
||||
// There is no good reason why insert should fail.
|
||||
if (SQLSTT <> SQLSUCCESS);
|
||||
SQLProblem('Insert into CUSTMAST ...');
|
||||
endif;
|
||||
endsr;
|
||||
|
||||
//=== UpdateRecd =============================================
|
||||
// Updates the record with the screen data.
|
||||
// The SQL WHERE checks the last time stamp and if different,
|
||||
// doesn't update because someone else updated the record.
|
||||
// (This isn't the only way to avoid pessimistic locking.)
|
||||
// SQLERRD(3) contains the actual number of records updated
|
||||
// when the update is successful.
|
||||
begsr UpdateRecd;
|
||||
NoErrors = *on;
|
||||
exec sql
|
||||
update CUSTMAST
|
||||
SET NAME = :SD_NAME,
|
||||
ADDR = :SD_ADDR,
|
||||
CITY = :SD_CITY,
|
||||
STATE = :SD_STATE,
|
||||
ZIP = :SD_ZIP,
|
||||
CORPPHONE = :SD_CORPPH,
|
||||
ACCTMGR = :SD_ACCTMGR,
|
||||
ACCTPHONE = :SD_ACCTPH,
|
||||
ACTIVE = :SD_ACTIVE,
|
||||
CHGTIME = CURRENT TIMESTAMP,
|
||||
CHGUSER = :CURR_USER
|
||||
where CUSTID = :CUSTID
|
||||
-- and compare timestamp
|
||||
and CHGTIME = :Orig_CHGTIME;
|
||||
select;
|
||||
when (SQLSTT = SQLNODATA); // Update Failed
|
||||
SflMsgSnt = SndSflMsg('DEM1002'); // Record changed, review.
|
||||
NoErrors = *off;
|
||||
// Show the changed data
|
||||
exsr ReadRecd;
|
||||
exsr FillScreenFields;
|
||||
|
||||
when (SQLSTT =SQLROWLOCKED); // Row locked
|
||||
SflMsgSnt = SndSflMsg('DEM1001' : SQLERRMC);
|
||||
NoErrors = *off;
|
||||
when (SQLSTT = SQLSUCCESS);
|
||||
|
||||
other;
|
||||
SQLProblem('Update CUSTMAST');
|
||||
endsl;
|
||||
endsr;
|
||||
|
||||
//=== ClearScreenData ========================================
|
||||
begsr ClearScreenData;
|
||||
clear DETAILS;
|
||||
endsr;
|
||||
|
||||
//=== ProtectAll =============================================
|
||||
begsr ProtectAll;
|
||||
Protect_SD_ALL = *on;
|
||||
endsr;
|
||||
|
||||
//=== UnProtectAll ===========================================
|
||||
begsr UnProtectAll;
|
||||
Protect_SD_ALL = *off;
|
||||
endsr;
|
||||
|
||||
//=== ScreenIO ===============================================
|
||||
// Writes and Reads the screen
|
||||
begsr ScreenIO;
|
||||
|
||||
write SH_HDR;
|
||||
write SFT_FKEY;
|
||||
|
||||
// Show any messages in the error subfile.
|
||||
if (SflMsgSnt = *on);
|
||||
write MSGCTL;
|
||||
endif;
|
||||
|
||||
exfmt Details;
|
||||
|
||||
// Clear most display file indicators
|
||||
clear dfIndClr;
|
||||
|
||||
// Clear any messages in the error subfile.
|
||||
if (SflMsgSnt = *on);
|
||||
SflMsgSnt = ClrMsgPgmQ(MainProc);
|
||||
write MSGCTL;
|
||||
endif;
|
||||
|
||||
endsr;
|
||||
|
||||
//=== BldFKeyText ============================================
|
||||
// Build the Function key text for the bottom of the screen.
|
||||
begsr BldFkeyText;
|
||||
SFT_KEYS=' ';
|
||||
SFT_KEYS = catB(SFT_KEYS : F4TEXT);
|
||||
SFT_KEYS = catB(SFT_KEYS : F5TEXT);
|
||||
SFT_KEYS = catB(SFT_KEYS : F12TEXT);
|
||||
endsr;
|
||||
|
||||
//=== CloseDownPgm ===========================================
|
||||
// Things to do before we issue a return to the caller
|
||||
begsr CloseDownPgm;
|
||||
// Closing the display file may cause any subfile display in
|
||||
// the caller to blank out.
|
||||
endsr;
|
||||
|
||||
//=== Init ===================================================
|
||||
// Every time initialization logic
|
||||
begsr Init;
|
||||
|
||||
//--- Analyse parameters ---
|
||||
if (%parms() = 0); // Close down
|
||||
if (%open(MTNCUSTD));
|
||||
close MTNCUSTD;
|
||||
endif;
|
||||
*inlr = *on;
|
||||
return;
|
||||
endif;
|
||||
|
||||
select;
|
||||
when ( %parms() = 1);
|
||||
Function = DISPLAYING;
|
||||
when ( %parms() >= 2);
|
||||
select;
|
||||
when ( pMaintain = ADDING);
|
||||
Function = ADDING;
|
||||
SH_FUNCT = CenterStr(H2TextA);
|
||||
when (pMaintain = EDITING);
|
||||
Function = EDITING;
|
||||
SH_FUNCT = CenterStr(H2TextE);
|
||||
other;
|
||||
Function = DISPLAYING;
|
||||
SH_FUNCT = CenterStr(H2TextD);
|
||||
endsl;
|
||||
other;
|
||||
// Should never happen
|
||||
endsl;
|
||||
|
||||
//--- Miscellaneous setup ---
|
||||
MainProc = %proc();
|
||||
MSGPGMQ = MainProc;
|
||||
SH_PGM = PgmName;
|
||||
clear CUSTMAST;
|
||||
clear dfIndDS;
|
||||
exsr BldFkeyText;
|
||||
|
||||
//--- Open display file ---
|
||||
if (not %open(MTNCUSTD));
|
||||
open MTNCUSTD;
|
||||
endif;
|
||||
endsr;
|
||||
end-proc;
|
||||
|
||||
//============================================================
|
||||
// S u b P r o c e d u r e s
|
||||
//============================================================
|
||||
|
||||
//=== CatB ===================================================
|
||||
// Concatenates a string to another string with a blank between.
|
||||
// If the target string is all blank to start with it will not
|
||||
// end up with a leading blank.
|
||||
dcl-proc catB;
|
||||
dcl-pi catB varchar(79);
|
||||
ToStr varchar(79) value;
|
||||
AddStr varchar(79) value;
|
||||
end-pi;
|
||||
if (ToStr=' ');
|
||||
return AddStr;
|
||||
else;
|
||||
return %trimr(ToStr) + ' ' + AddStr;
|
||||
endif;
|
||||
end-proc;
|
||||
//=== SQLProblem ===============================================
|
||||
// For those "Never should happen" SQL errors.
|
||||
// Issues DUMP(A) to dump memory, then ends program by
|
||||
// sending an *ESCAPE message of the supplied debugging text.
|
||||
dcl-proc SQLProblem;
|
||||
dcl-pi SQLProblem;
|
||||
piSQLDebug varchar(1024) value;
|
||||
end-pi;
|
||||
|
||||
//--- Local Variables ------------------------------------------
|
||||
dcl-s wkSQLDebug varchar(1024);
|
||||
|
||||
wkSQLDebug = 'SQLSTT ' + SQLSTT
|
||||
+ ' << Unexpected SQL Return Code: '
|
||||
+ piSQLDebug;
|
||||
dump(a);
|
||||
SndEscMsg(wkSQLDebug);
|
||||
return;
|
||||
end-proc;
|
||||
|
||||
//--------------------------------------------------------------
|
||||
// Procedure name: SndSflMsg
|
||||
// Purpose: Send a message to the Error Subfile
|
||||
// Returns: *ON
|
||||
// Parameter: ErrMsgId => Msg Id to Send
|
||||
// Parameter: ErrMsgData => Optional Error Message Data
|
||||
// Parameter: ErrMsgFile => Optional Error Message File
|
||||
// Defaults to CUSTMSGF
|
||||
//--------------------------------------------------------------
|
||||
dcl-proc SndSflMsg;
|
||||
dcl-pi SndSflMsg ind;
|
||||
ErrMsgId char(7) const;
|
||||
ErrMsgData char(512) const options(*nopass:*varsize);
|
||||
ErrMsgFile char(10) const options(*nopass);
|
||||
end-pi;
|
||||
// Local fields
|
||||
dcl-s retField ind;
|
||||
dcl-s wkMsgId char(7);
|
||||
dcl-s wkMsgFile char(10);
|
||||
dcl-s wkMsgData varchar(512);
|
||||
|
||||
if (%parms >2);
|
||||
wkMsgFile = ErrMsgFile;
|
||||
else;
|
||||
wkMsgFile = 'CUSTMSGF';
|
||||
ENDIF;
|
||||
if (%parms > 1);
|
||||
wkMsgData = ErrMsgData;
|
||||
else;
|
||||
wkMsgData = ' ';
|
||||
ENDIF;
|
||||
wkMsgId = ErrMsgId;
|
||||
SNDMSGPGMQ(MainProc:
|
||||
wkMsgId:
|
||||
wkMsgFile:
|
||||
wkMsgData);
|
||||
|
||||
retField = *on;
|
||||
RETURN retField;
|
||||
|
||||
end-proc;
|
||||
@@ -0,0 +1,34 @@
|
||||
# USPS_Address - QSYS2_HTTP_GET calling the US Post Office webtools API AddressValidateRequest
|
||||
|
||||
USADRVAL is a service program in RPG Free which uses the QSYS2.HTTP_GET SQL function to call the USPS AddressValidateRequest API. The API returns a validated and standarized address (or an error) in an XML document, which is then parsed with the SQL XMLPARSE function and returned to the caller.
|
||||
|
||||
To use the USADRVAL you need to obtain a User Id from the US Post Office. [Follow link here](https://www.usps.com/business/web-tools-apis/general-api-developer-guide.htm#_Toc24631952) to register for a free User Id,
|
||||
|
||||
Included is a demo interactive program which is a rewritten version of MNTCUSTR in the [5250_Subfile](https://github.com/SJLennon/IBM-i-RPG-Free-CLP-Code/tree/master/5250_Subfile) directory.
|
||||
|
||||
## CRTBNDDIR.CLLE
|
||||
|
||||
Simple program to create the ADRVAL binding directory.
|
||||
|
||||
### MTNCUSTR/MTNCUSTD
|
||||
|
||||
Demo program and display file to maintain a customer master. To use the program you must compile the objects in the [5250_Subfile](https://github.com/SJLennon/IBM-i-RPG-Free-CLP-Code/tree/master/5250_Subfile) directory, then compile these two objects.
|
||||
|
||||
This program uses a single address line, which is passed as ADDRESS2 to the API. If you decide to use an additional address line, pass it in ADDRESS1.
|
||||
|
||||
(This program needs some additional coding to allow you to ignore the USPS standardized address.)
|
||||
|
||||
### USADRVAL_T
|
||||
|
||||
A program to exercise USADRVAL with a some addresses, writing the input and output side by side to QSYSPRT.
|
||||
|
||||
### USADRVAL
|
||||
|
||||
The service program.
|
||||
|
||||
Input address and output address are passed in the USADRVALDS data structure, which is found in [Copy_Mbrs](https://github.com/SJLennon/IBM-i-RPG-Free-CLP-Code/commit/c875b751e3ea6055ca295f35caef498b9067f7bb)
|
||||
|
||||
A call looks like this:
|
||||
``returned address = USAdrVal(input address);``
|
||||
|
||||
If ADDRESS2 is non blank, they you have a valid address. Otherwise find a description of the problem in the DESCRIPTION field.
|
||||
@@ -0,0 +1,128 @@
|
||||
**free
|
||||
//==============================================================
|
||||
//=== USADRVAL: Service program to validate and standardize
|
||||
//=== a USA address.
|
||||
//=== Calls the USPS webtools API AddressValidateRequest.
|
||||
//====================================================================
|
||||
// See US Postal Service documentation:
|
||||
// www.usps.com/business/web-tools-apis/address-information-api.htm#_Toc39492052
|
||||
// www.usps.com/business/web-tools-apis/general-api-developer-guide.htm
|
||||
//====================================================================
|
||||
// CRTRPGMOD MODULE(USADRVAL)
|
||||
// CRTSRVPGM SRVPGM(USADRVAL) EXPORT(*ALL)
|
||||
// CRTBNDDIR BNDDIR(ADRVAL_BND) TEXT('Address Validation Binding Dir')
|
||||
// ADDBNDDIRE BNDDIR(ADRVAL_BND) OBJ((USADRVAL *SRVPGM *DEFER))
|
||||
// CRTDTAARA DTAARA(USPS_ID) TYPE(*CHAR) LEN(20) VALUE(your user id)
|
||||
//====================================================================
|
||||
// Input address information is passed in a data structure.
|
||||
// The standardized address is returned, also in a data structure.
|
||||
// For ease of use, the same data structure layout is used for
|
||||
// input and output, but it doesn't have to be the same memory
|
||||
// in the caller. Use copy member USAdrValDS.
|
||||
//====================================================================
|
||||
|
||||
ctl-opt
|
||||
nomain
|
||||
bnddir('SQL_BND')
|
||||
option(*nodebugio: *srcstmt)
|
||||
;
|
||||
//=== Prototypes =====================================================
|
||||
/copy copy_mbrs,Srv_SQL_P
|
||||
|
||||
//=== Parameter Data Structure Template ==============================
|
||||
/copy copy_mbrs,USAdrValDS
|
||||
|
||||
// === Data area containing your USPS supplied User id. ==============
|
||||
// (The USPS supplied USER ID length is not clear, so I made it
|
||||
// longer than the 12-char one supplied to me..)
|
||||
dcl-ds USPS_ID dtaara len(20) qualified;
|
||||
end-ds;
|
||||
|
||||
//=== USAdrVal =======================================================
|
||||
dcl-proc USAdrVal export;
|
||||
dcl-pi USAdrVal likeds(USAdrValDS);
|
||||
pi likeds (USAdrValDS);
|
||||
end-pi;
|
||||
|
||||
dcl-c SQLSUCCESS '00000';
|
||||
dcl-c SQLNODATA '02000';
|
||||
|
||||
// XML returned from the USPS API
|
||||
dcl-s retXML char(2048) ccsid(*UTF8);
|
||||
|
||||
// Returned outparm data structure
|
||||
dcl-ds po likeds(USAdrValDS);
|
||||
|
||||
dcl-s ID varchar(20);
|
||||
// Get USPS UserID.
|
||||
in USPS_ID;
|
||||
ID = %trim(USPS_ID);
|
||||
|
||||
clear po;
|
||||
|
||||
// Call USPS Address Validate API. It returns an XML document.
|
||||
exec sql
|
||||
values QSYS2.HTTP_GET(
|
||||
'http://production.shippingapis.com/ShippingAPI.dll'
|
||||
concat '?API=Verify&XML=' concat
|
||||
url_encode(
|
||||
'<AddressValidateRequest ' concat
|
||||
'USERID="' concat :ID concat '">' concat
|
||||
'<Revision>1</Revision>' concat
|
||||
'<Address ID="0">' concat
|
||||
'<Address1>' concat :pi.Address1 concat '</Address1>' concat
|
||||
'<Address2>' concat :pi.Address2 concat '</Address2>' concat
|
||||
'<City>' concat :pi.City concat '</City>' concat
|
||||
'<State>' concat :pi.State concat '</State>' concat
|
||||
'<Zip5>' concat :pi.Zip5 concat '</Zip5>' concat
|
||||
'<Zip4>' concat :pi.Zip4 concat '</Zip4>' concat
|
||||
'</Address>' concat
|
||||
'</AddressValidateRequest>'
|
||||
)
|
||||
) into :retXML;
|
||||
if (SQLSTATE <> SQLSUCCESS);
|
||||
SQLProblem('USPS API Call');
|
||||
endif;
|
||||
|
||||
// Parse the XML document into program variables. Even if the API
|
||||
// returns an error the SQL should not fail since defaults are set
|
||||
exec sql
|
||||
select x.* into :po.Address1, :po.Address2, :po.City,
|
||||
:po.State, :po.Zip5, :po.Zip4
|
||||
from xmltable
|
||||
('AddressValidateResponse/Address'
|
||||
passing xmlparse(document :retXML)
|
||||
columns
|
||||
Address1 char(30) path 'Address1' default ' ',
|
||||
Address2 char(30) path 'Address2' default ' ',
|
||||
City Char(30) path 'City' default ' ',
|
||||
State char(2) path 'State' default ' ',
|
||||
zip5 char(5) path 'Zip5' default ' ',
|
||||
Zip4 char(4) path 'Zip4' default ' '
|
||||
) as x;
|
||||
if (SQLSTATE <> SQLSUCCESS);
|
||||
SQLProblem('XMLPARSE of Addr');
|
||||
endif;
|
||||
|
||||
// If a city was returned, assume it worked.
|
||||
if (po.City <> ' ');
|
||||
return po;
|
||||
endif;
|
||||
|
||||
// If no city, then parse the error XML
|
||||
exec SQL
|
||||
select x.* into :po.Number, :po.Source, :po.Description
|
||||
from xmltable
|
||||
('AddressValidateResponse/Address/Error'
|
||||
passing xmlparse(document :retXML)
|
||||
columns
|
||||
Number integer path 'Number',
|
||||
Source char(30) path 'Source',
|
||||
Description varChar(512) path 'Description'
|
||||
) as x;
|
||||
if (SQLSTATE <> SQLSUCCESS);
|
||||
SQLProblem('XMLPARSE of Error');
|
||||
endif;
|
||||
return po;
|
||||
|
||||
end-proc USAdrVal;
|
||||
@@ -0,0 +1,174 @@
|
||||
**free
|
||||
ctl-opt debug option(*nodebugio: *srcstmt)
|
||||
dftactgrp(*no) actgrp(*caller)
|
||||
bnddir('UTIL_BND':'SQL_BND':'ADRVAL_BND')
|
||||
main(Main);
|
||||
//====================================================================
|
||||
// Program to exercise USADRVAL.
|
||||
// Results are printed to QSYSPPRT.
|
||||
//====================================================================
|
||||
/copy copy_mbrs,USAdrValDS
|
||||
/copy copy_mbrs,Srv_Msg_P
|
||||
/copy copy_mbrs,USAdrVal_p
|
||||
|
||||
dcl-f qsysprt printer(132) usropn;
|
||||
|
||||
dcl-proc Main;
|
||||
|
||||
dcl-ds pi likeds(USAdrValDS);
|
||||
dcl-ds po likeds(USAdrValDS);
|
||||
|
||||
*inlr = *on;
|
||||
open qsysprt;
|
||||
|
||||
pi.Address1 = 'Suite 2';
|
||||
pi.Address2 = '8 Wildwood Drive';
|
||||
pi.City = 'Old Lyme';
|
||||
pi.State = 'CT';
|
||||
pi.Zip5='';
|
||||
pi.Zip4 ='';
|
||||
|
||||
po = USAdrVal(pi);
|
||||
DspAdr(pi:po);
|
||||
|
||||
pi.Address1 = ' ';
|
||||
po = USAdrVal(pi);
|
||||
DspAdr(pi:po);
|
||||
|
||||
pi.Address2 = 'Suite 2 ' + pi.Address2;
|
||||
po = USAdrVal(pi);
|
||||
DspAdr(pi:po);
|
||||
|
||||
pi.Address2 = 'Wildwood Drive';
|
||||
po = USAdrVal(pi);
|
||||
DspAdr(pi:po);
|
||||
|
||||
pi.Address2 = '8 Wildwood Drive, Suite 2';
|
||||
pi.City = ' ';
|
||||
pi.Zip5 = '06371';
|
||||
|
||||
po = USAdrVal(pi);
|
||||
DspAdr(pi:po);
|
||||
|
||||
pi.Address1 = '';
|
||||
pi.Address2 = '300 west green street';
|
||||
pi.City = 'pasadena';
|
||||
pi.State = 'ca';
|
||||
pi.Zip5='';
|
||||
pi.Zip4 ='';
|
||||
|
||||
po = USAdrVal(pi);
|
||||
DspAdr(pi:po);
|
||||
|
||||
pi.Address2 = '6802 rio grande blvd nw ';
|
||||
pi.City = 'los ranchos de albuquerque';
|
||||
pi.State = 'nm';
|
||||
pi.Zip5='';
|
||||
pi.Zip4 ='';
|
||||
|
||||
po = USAdrVal(pi);
|
||||
DspAdr(pi:po);
|
||||
|
||||
pi.Address1 = 'Apt 22 ';
|
||||
pi.Address2 = '13 SENDERO';
|
||||
pi.City = 'Rancho Santa Margarita';
|
||||
pi.State = 'ca';
|
||||
pi.Zip5='';
|
||||
pi.Zip4 ='';
|
||||
|
||||
po = USAdrVal(pi);
|
||||
DspAdr(pi:po);
|
||||
|
||||
close qsysprt;
|
||||
return;
|
||||
end-proc Main;
|
||||
|
||||
//=== Routine to print input and outpur side by side =================
|
||||
dcl-proc DspAdr;
|
||||
dcl-pi DspAdr;
|
||||
pi likeds(USAdrValDS);
|
||||
po likeds(USAdrValDS);
|
||||
end-pi;
|
||||
dcl-c WLOC 1;
|
||||
dcl-c ILOC 15;
|
||||
dcl-c OLOC 46;
|
||||
dcl-s tNum int(10) inz(1) static;
|
||||
|
||||
dcl-s l char(132);
|
||||
%subst(l:ILOC) = 'INPUT';
|
||||
%subst(l:OLOC) = 'OUTPUT';
|
||||
writeln(l);
|
||||
|
||||
%subst(l:WLOC:11) = 'Address1';
|
||||
%subst(l:ILOC) = pi.address1;
|
||||
%subst(l:OLOC) = po.address1;
|
||||
writeln(l);
|
||||
|
||||
%subst(l:WLOC:11) = 'Address2';
|
||||
%subst(l:ILOC) = pi.address2;
|
||||
%subst(l:OLOC) = po.address2;
|
||||
writeln(l);
|
||||
|
||||
%subst(l:WLOC:11) = 'City';
|
||||
%subst(l:ILOC) = pi.City;
|
||||
%subst(l:OLOC) = po.City;
|
||||
writeln(l);
|
||||
|
||||
%subst(l:WLOC:11) = 'State';
|
||||
%subst(l:ILOC) = pi.State;
|
||||
%subst(l:OLOC) = po.State;
|
||||
writeln(l);
|
||||
|
||||
%subst(l:WLOC:11) = 'Zip5';
|
||||
%subst(l:ILOC) = pi.Zip5;
|
||||
%subst(l:OLOC) = po.ZIP5;
|
||||
writeln(l);
|
||||
|
||||
%subst(l:WLOC:11) = 'Zip4';
|
||||
%subst(l:ILOC) = pi.Zip4;
|
||||
%subst(l:OLOC) = po.Zip4;
|
||||
writeln(l);
|
||||
if (po.Description <> ' ');
|
||||
%subst(l:WLOC:11) = 'Number';
|
||||
%subst(l:OLOC) = %char(po.Number);
|
||||
writeln(l);
|
||||
|
||||
%subst(l:WLOC:11) = 'Source';
|
||||
%subst(l:OLOC) = po.Source;
|
||||
writeln(l);
|
||||
|
||||
%subst(l:WLOC:11) = 'Description';
|
||||
%subst(l:OLOC) = po.Description;
|
||||
writeln(l);
|
||||
endif;
|
||||
|
||||
writeln('------------------------------------------------------------');
|
||||
tNum += 1;
|
||||
|
||||
return;
|
||||
end-proc DspAdr;
|
||||
|
||||
//=== WriteLn: Courtesy of Ted Hold and ITJungle.com =================
|
||||
// https://www.itjungle.com/2021/10/25/guru-quick-and-handy-rpg-output-take-2/
|
||||
dcl-proc writeln;
|
||||
dcl-pi *n;
|
||||
inString varchar(132) const;
|
||||
inPosition uns(3) const options(*nopass);
|
||||
end-pi;
|
||||
|
||||
dcl-ds prtLineDS qualified;
|
||||
line char(132);
|
||||
end-ds;
|
||||
|
||||
dcl-ds prtLine likeds(prtLineDS);
|
||||
dcl-s Posn uns(3);
|
||||
|
||||
if (%parms() >= %ParmNum(inPosition));
|
||||
Posn = inPosition;
|
||||
else;
|
||||
Posn = 1;
|
||||
endif;
|
||||
|
||||
%subst(prtLine.line: Posn) = inString;
|
||||
write qsysprt prtLine;
|
||||
end-proc writeln;
|
||||
Reference in New Issue
Block a user