diff --git a/cfdemo/Rules.mk b/cfdemo/Rules.mk index 8b9cc8e8..35f7db6b 100644 --- a/cfdemo/Rules.mk +++ b/cfdemo/Rules.mk @@ -25,7 +25,10 @@ products2l.file: qddssrc/products2l.lf | productsp.file # Message file and menu menu.msgf: menu.msgf -menu.menu: menu.msgf | menu.file +# .file MUST be a normal prereq (not order-only) or codermake silently +# drops the CRTMNU recipe -- see perp/DDL_STYLE_GUIDE.md "codermake +# gotchas" for the general rule (discovered there, applies here too). +menu.menu: menu.msgf menu.file # Simple program hellor.pgm: qrpglesrc/hellor.rpgle qddssrc/hellod.dspf | hellod.file diff --git a/cfdemo/build/AITSK00019.lib b/cfdemo/build/AITSK00019.lib new file mode 100644 index 00000000..e69de29b diff --git a/cfdemo/build/menu.file b/cfdemo/build/menu.file new file mode 100644 index 00000000..e69de29b diff --git a/cfdemo/build/menu.menu b/cfdemo/build/menu.menu new file mode 100644 index 00000000..e69de29b diff --git a/cfdemo/build/menu.msgf b/cfdemo/build/menu.msgf new file mode 100644 index 00000000..e69de29b diff --git a/cfdemo/menu.msgf b/cfdemo/menu.msgf index 9868ee1f..a588418f 100644 --- a/cfdemo/menu.msgf +++ b/cfdemo/menu.msgf @@ -2,4 +2,5 @@ crtmsgf msgf($LIBRARY/$NAME) addmsgd msgid(usr0001) msgf($LIBRARY/$NAME) msg('call wrkcustr') seclvl(*none) sev(00) fmt(*none) addmsgd msgid(usr0002) msgf($LIBRARY/$NAME) msg('call wrkcustro') seclvl(*none) sev(00) fmt(*none) addmsgd msgid(usr0003) msgf($LIBRARY/$NAME) msg('call wrkcusteo') seclvl(*none) sev(00) fmt(*none) +addmsgd msgid(usr0004) msgf($LIBRARY/$NAME) msg('go perpdemo/perpmnu') seclvl(*none) sev(00) fmt(*none) addmsgd msgid(usr0090) msgf($LIBRARY/$NAME) msg('signoff') seclvl(*none) sev(00) fmt(*none) diff --git a/cfdemo/qddssrc/menu.dspf b/cfdemo/qddssrc/menu.dspf index 8041879a..9744425b 100644 --- a/cfdemo/qddssrc/menu.dspf +++ b/cfdemo/qddssrc/menu.dspf @@ -24,6 +24,7 @@ A 5 7'1. Work with Customers' A 6 7'2. Work with Customers (RPGOA)' A 7 7'3. Work with Customers (EJS)' + A 8 7'4. Go to PERP menu (PERPMNU)' A 10 6'90. Sign off' A* CMDPROMPT Do not delete this DDS spec. A 021 2'Selection: - diff --git a/cfdemo/tmp/logs/AITSK00019.lib.log b/cfdemo/tmp/logs/AITSK00019.lib.log new file mode 100644 index 00000000..e69de29b diff --git a/cfdemo/tmp/logs/menu.file.log b/cfdemo/tmp/logs/menu.file.log new file mode 100644 index 00000000..777828f7 --- /dev/null +++ b/cfdemo/tmp/logs/menu.file.log @@ -0,0 +1,92 @@ +CPC7301: File QDDSSRC created in library AITSK00019. +CPC7305: Member MENU added to file QDDSSRC in AITSK00019. +CPC7301: File MENU created in library AITSK00019. + 5770SS1 V7R5M0 220415 Data Description AITSK00019/MENU 8/23/26 16:28:31 Page 1 + File name . . . . . . . . . . . . . . . . . . . . . : MENU + Library name . . . . . . . . . . . . . . . . . . : AITSK00019 + File attribute . . . . . . . . . . . . . . . . . . : Display + Source file containing DDS . . . . . . . . . . . . : QDDSSRC + Library name . . . . . . . . . . . . . . . . . . : AITSK00019 + Source member containing DDS . . . . . . . . . . . : MENU + Source member last changed . . . . . . . . . . . . : 08/26/26 16:28:30 + Source listing options . . . . . . . . . . . . . . : *SOURCE *LIST *NOSECLVL *NOEVENTF + DDS generation severity level . . . . . . . . . . . : 20 + DDS flagging severity level . . . . . . . . . . . . : 00 + Authority . . . . . . . . . . . . . . . . . . . . . : *LIBCRTAUT + Replace file . . . . . . . . . . . . . . . . . . . : *YES + Text . . . . . . . . . . . . . . . . . . . . . . . : + Compiler . . . . . . . . . . . . . . . . . . . . . : IBM System i5 Data Description Processor + Data Description Source + SEQNBR *...+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8 Date + 1 A* Free Form Menu: MENU + 2 A DSPSIZ(24 80 *DS3 - + 3 A 27 132 *DS4) + 4 A CHGINPDFT + 5 A INDARA + 6 A PRINT(*LIBL/QSYSPRT) + 7 A R MENU + * CPD5235-.********* + * CPD8111-********** + 8 A DSPMOD(*DS3) + 9 A LOCK + 10 A SLNO(01) + 11 A CLRL(*ALL) + * CPD8018-* + 12 A ALWROL + * CPD8018-* + 13 A CF03 + 14 A HELP + 15 A HOME + 16 A HLPRTN + 17 A 1 2'MENU' + 18 A COLOR(BLU) + 19 A 1 29'Agentic Coding Demo Menu' + 20 A DSPATR(HI) + 21 A COLOR(WHT) + 22 A 3 2'Select one of the following:' + 23 A COLOR(BLU) + 24 A 5 7'1. Work with Customers' + 25 A 6 7'2. Work with Customers (RPGOA)' + 26 A 7 7'3. Work with Customers (EJS)' + 27 A 8 7'4. Go to PERP menu (PERPMNU)' + 28 A 10 6'90. Sign off' + 29 A* CMDPROMPT Do not delete this DDS spec. + 30 A 021 2'Selection: - + 31 A ' + * * * * * E N D O F S O U R C E * * * * * + 5770SS1 V7R5M0 220415 Data Description AITSK00019/MENU 8/23/26 16:28:31 Page 2 + Expanded Source + Field Buffer position + SEQNBR *...+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8 length Out In + 2 DSPSIZ(24 80 *DS3 - + 2 27 132 *DS4) CHGINPDFT + + 5 INDARA PRINT(*LIBL/QSYSPRT) + 7 R MENU DSPMOD(*DS3) LOCK SLNO(01) + + 11 CLRL(*ALL) ALWROL CF03 HELP HOME + + 16 HLPRTN + 17 1 2'MENU' COLOR(BLU) 4 + 19 1 29'Agentic Coding Demo Menu' + 24 + 20 DSPATR(HI) COLOR(WHT) + 22 3 2'Select one of the following:' + 28 + 23 COLOR(BLU) + 24 5 7'1. Work with Customers' 22 + 25 6 7'2. Work with Customers (RPGOA)' 30 + 26 7 7'3. Work with Customers (EJS)' 28 + 27 8 7'4. Go to PERP menu (PERPMNU)' 28 + 28 10 6'90. Sign off' 12 + 30 21 2'Selection: - 38 + 30 ' + * * * * * E N D O F E X P A N D E D S O U R C E * * * * * + 5770SS1 V7R5M0 220415 Data Description AITSK00019/MENU 8/23/26 16:28:31 Page 3 + Messages + ID Severity Number + * CPD5235 10 1 Message . . . . : Record name same as name of file being created. + * CPD8018 10 2 Message . . . . : Keyword may not function as expected with DSPMOD. + * CPD8111 10 1 Message . . . . : Record may not function as expected. + 5770SS1 V7R5M0 220415 Data Description AITSK00019/MENU 8/23/26 16:28:31 Page 4 + Message Summary + Total Informational Warning Error Severe + (0-9) (10-19) (20-29) (30-99) + 4 0 4 0 0 + * CPC7301 00 Message . . . . : File MENU created in library AITSK00019. + * * * * * E N D O F C O M P I L A T I O N * * * * * diff --git a/cfdemo/tmp/logs/menu.menu.log b/cfdemo/tmp/logs/menu.menu.log new file mode 100644 index 00000000..0bcf05f3 --- /dev/null +++ b/cfdemo/tmp/logs/menu.menu.log @@ -0,0 +1 @@ +CPC9801: Object MENU type *MENU created in library AITSK00019. diff --git a/cfdemo/tmp/logs/menu.msgf.log b/cfdemo/tmp/logs/menu.msgf.log new file mode 100644 index 00000000..033bdfb8 --- /dev/null +++ b/cfdemo/tmp/logs/menu.msgf.log @@ -0,0 +1 @@ +CPC9801: Object MENU type *MSGF created in library AITSK00019. diff --git a/perp/.codermake/config.json b/perp/.codermake/config.json new file mode 100644 index 00000000..d21b5315 --- /dev/null +++ b/perp/.codermake/config.json @@ -0,0 +1,10 @@ +{ + "targetRelease": "V7R4M0", + "compileOptions": { + "crtbndrpg": { "dbgview": "*all" }, + "crtrpgmod": { "dbgview": "*all" }, + "crtsqlrpgi": { "dbgview": "*source" }, + "crtbndcbl": { "dbgview": "*all" }, + "runsqlstm": { "commit": "*none", "errlvl": "10" } + } +} diff --git a/perp/AGENTS.md b/perp/AGENTS.md new file mode 100644 index 00000000..e434e1ba --- /dev/null +++ b/perp/AGENTS.md @@ -0,0 +1,89 @@ +# Instructions for Agents — PERP module + +This directory holds the **PreSales ERP (PERP)** module — a greenfield ERP +demo playground built alongside `cfdemo/` in this repo. + +Tracked in Jira project **PERP**; design reference lives in Confluence page +[PreSales ERP Development Project (PERP)](https://profoundlogicsupport.atlassian.net/wiki/spaces/CPP/pages/2511470593/). + +## Before touching anything + +Read **[DDL_STYLE_GUIDE.md](DDL_STYLE_GUIDE.md)** first. It sets the conventions +for every table, index, view, and CL in this module. In particular: + +- One `.table.sql` file per table, snake_case +- Explicit `FOR SYSTEM NAME` / `FOR COLUMN` on every table and column +- Standard audit block on every table (`created_at/by`, `updated_at/by`, `is_active`) +- FKs and CHECKs declared in DDL, not enforced in app code +- Composite PKs with `company_code` leading on multi-tenant tables +- All tables journaled from day one (see `qclsrc/perpjrn.clle`) +- No `SET OPTION COMMIT = *NONE` in RPG — real commitment control against the + perp journal + +## Runtime-only gotchas that clean compiles won't catch + +Three gotchas on this environment routinely compile clean at severity 00 +and then crash at runtime on the first exercise. Always factor these in +when adding a new RPG or SQLRPGLE program under `perp/qrpglesrc/`: + +- **`ctl-opt datfmt(*iso)` is mandatory for any program that touches + Date values.** The job DATFMT is `*MDY` (year range 1940-2039). + Without the ctl-opt override every RPG Date variable inherits that + narrow range as its storage format and any value outside it (a + `0001-01-01` sentinel, an SQL fetch of an out-of-range date, a DSPF + `L DATFMT(*ISO)` read) crashes with `RNQ0114`. Three-layer fix: + - Put `datfmt(*iso)` on `ctl-opt`. + - Parse every literal with `%date('yyyy-mm-dd' : *ISO)`. + - Keep any Date value that will be assigned to an SQL host variable + inside 1940-2039 (e.g. sentinels `1940-01-01`/`2039-12-31`) — the + SQL precompiler generates its intermediate host vars with the JOB + DATFMT and ignores `ctl-opt datfmt(*iso)`, so the SQL side stays + capped at *MDY even after the first two fixes. + + Full analysis in `DDL_STYLE_GUIDE.md` §13. This bit every PO program + during PERP-7 and burned three round-trips before the third layer + landed — don't repeat. + +- **`%subst(varchar : 1 : N)` fails when `N > %len(current data)`, not + just when `N > declared max`.** A VARCHAR(20) column holding + `'OPEN'` (4 chars) can't answer `%subst(..., 1, 10)` — `RNQ0100`. + For "fit into a fixed-width display field", drop the `%subst` and + use direct assignment: RPG right-pads or truncates automatically. + Only reach for `%subst` when you actually need a middle slice, and + guard with `%min(%len(...), N)` when you do. + +- **`%editc(int : 'X')` produces hex, not decimal.** For displaying a + numeric doc-number as a plain string (PO number, requisition + number, line number), use `%char()`. `%editc` with `'X'` returns + the hex representation of the internal byte pattern — PERP-7's + first live browse rendered every PO number as `0000000000` before + this was caught. + +## Build target + +Objects build into the **`PERPDEMO`** library on IBM i. `PERPDEMO` is a +shared demo library (not the per-task library) and has been created for this +purpose. When you build from this module, point `IBMI_BUILD_LIBRARY` at +`PERPDEMO` for these sources. + +Source physical files in `PERPDEMO` (all `RCDLEN(112)`): +`QRPGLESRC`, `QDDSSRC`, `QSQLSRC`, `QCLSRC`, `QCMDSRC`, `QMENUSRC`, `QSRVSRC`, +`QPNLSRC`. + +## Directory layout + +| Subdir | Holds | +|--------------|----------------------------------------------------------------| +| `qddlsrc/` | SQL DDL — `.table.sql`, `.index.sql`, `.view.sql`, `.proc.sql` | +| `qrpglesrc/` | RPG ILE / SQLRPGLE programs and modules | +| `qddssrc/` | DDS — `.pf`, `.lf`, `.dspf`, `.prtf` (5250 baseline only) | +| `qclsrc/` | CL / CLLE — library setup, journaling, hooks | +| `.codermake/config.json` | Module-scoped compile options (adds `runsqlstm`) | +| `Rules.mk` | Module build rules — always edit this, never the Makefile | + +## Building + +Run `codermake` from the repo root as usual. The module-local +`.codermake/config.json` layers on top of the repo-level one and adds the +`runsqlstm` compile options used to build `.table.sql` / `.index.sql` / +`.view.sql` / `.proc.sql` sources into `PERPDEMO`. diff --git a/perp/DDL_STYLE_GUIDE.md b/perp/DDL_STYLE_GUIDE.md new file mode 100644 index 00000000..d89233dc --- /dev/null +++ b/perp/DDL_STYLE_GUIDE.md @@ -0,0 +1,834 @@ +# PERP SQL DDL Style Guide + +The `ibmi-agentic/perp/` module is greenfield — it introduces SQL DDL, FKs, +CHECK constraints, and journaling into a repository that until now used only +DDS `.pf` sources with no referential integrity and no commitment control. + +Every convention below is being **set** by this module. Every subsequent PERP +story must follow it. The one worked example — `example_reference.table.sql` +in `qddlsrc/` — demonstrates every convention in this document. + +Design decisions and the rationale behind each choice live on the Confluence +page **[Design Decisions & Conventions](https://profoundlogicsupport.atlassian.net/wiki/spaces/CPP/pages/2511831043/)**. +This guide is the codebase-side rendering of that reference. + +--- + +## 1. File conventions + +- **One `.table.sql` file per table.** No multi-object files. +- **snake_case** file names matching the SQL table name — e.g. + `inventory_master.table.sql` creates the table `inventory_master`. +- **Extensions match object type**, so `codermake` maps them to `RUNSQLSTM`: + - `.table.sql` → `CRTPF` via `RUNSQLSTM` (SQL table) + - `.index.sql` → `CRTLF` via `RUNSQLSTM` (SQL index) + - `.view.sql` → `CRTLF` via `RUNSQLSTM` (SQL view) + - `.proc.sql` → `CRTPGM` via `RUNSQLSTM` (SQL stored procedure) +- Sources live under **`ibmi-agentic/perp/qddlsrc/`**. + +## 2. Short-name mapping + +DB2 for i has a 128-byte SQL name **and** a 10-byte system name for every +table and column. If you don't declare the system name explicitly, DB2 +generates one — typically a truncated, non-obvious string that RPG programs +must then reference. That defeats the point of readable names in RPG. + +**Every table** carries an explicit `FOR SYSTEM NAME`. **Every column** carries +an explicit `FOR COLUMN`. The system name is uppercase and ≤ 10 chars. + +**Exception — SQL name is already a valid system name.** DB2 for i rejects +`FOR SYSTEM NAME X` / `FOR COLUMN X` when the target SQL name is itself a +valid ≤10-char system name (all-alpha, or underscores allowed). In that case +providing a redundant *or different* system name raises `SQL7029: System name +X cannot be specified`. Two situations trigger this: + +1. The SQL name is ≤ 10 chars and pure alphanumeric, and you ask for the + same value as the auto-derivation — e.g. `CREATE TABLE company FOR SYSTEM + NAME COMPANY` or `city FOR COLUMN CITY`. +2. The SQL name is ≤ 10 chars and *already* a valid system name (underscores + allowed), and you ask for a *different* value — e.g. `perp_user FOR + SYSTEM NAME PERPUSR`. DB2 has no way to store a second short name here; + the SQL name is the short name. + +Fix: either omit the `FOR SYSTEM NAME` / `FOR COLUMN` clause and let DB2 +auto-derive, or rename the SQL identifier so it needs a short name (e.g. +`city` → `city_name FOR COLUMN CITY`, `perp_user` → keep the SQL name and +accept `PERP_USER` as the system name — RPG programs `dcl-f perp_user`). + +**Don't trust the SQL7029 message text as a hint at the real system name.** +`SQL7029: System name X cannot be specified` echoes back whatever value +*you* proposed — it is not telling you what DB2 actually auto-derived. +(Learned in PERP-20: an explicit `FOR SYSTEM NAME ITMCLS` on `item_class` +raised `SQL7029: System name ITMCLS cannot be specified`, which reads like +confirmation that `ITMCLS` is correct — it isn't. The real auto-derived +name, confirmed via `DSPOBJD OBJ(PERPDEMO/*ALL) OBJTYPE(*FILE)`, is +`ITEM_CLASS` — DB2 only abbreviates when the SQL name exceeds 10 characters, +and `item_class`/`item_lot` are exactly 10/8.) After hitting this error, +omit the clause, build, then confirm the real object name with `DSPOBJD` +before writing anything downstream (Rules.mk targets, `PERPSJPF` calls, +RPG `dcl-f`) against it — don't guess an abbreviation. + +Related: **`LABEL ON TABLE` text is capped at 50 characters** on DB2 for i; +longer text raises `SQL0107`. Column labels have the same cap. + +**A short column name can trip the same rule with a different error.** +Learned in PERP-33: `notes FOR COLUMN NOTES CLOB(16K)` raises `SQL0612: +NOTES is a duplicate column name`, not the `SQL7029` shown above for tables +— same root cause (the SQL name `notes` is already a valid ≤10-char system +name, so the explicit `FOR COLUMN NOTES` collides with the auto-derivation), +just a different diagnostic at the column level. Fix is identical: drop the +redundant `FOR COLUMN` clause and let it auto-derive. + +**Auto-derived short names for >10-char SQL names are not a simple +truncation — they can be a sequential counter with no relation to the SQL +name at all.** Learned in PERP-28: `item_vendor` (11 chars) and +`item_vendor_price` (18 chars) both share the `ITEM` prefix with the +already-existing `item`/`item_class`/`item_lot` tables, and DB2 for i's +abbreviation algorithm produced `ITEM_00001` and `ITEM_00003` (not +`ITMVND`/`ITMVPRC` or any other intuitive abbreviation) to avoid a +collision. There is no way to predict this from the SQL name — always +confirm with `DSPOBJD OBJ(PERPDEMO/*ALL) OBJTYPE(*FILE)` right after the +build and use the *real* object name in every downstream reference +(`PERPSJPF` calls, `DSPFD`, RPG `dcl-f`/embedded-SQL is unaffected since it +resolves by SQL name, but any native/CL-level reference needs the real +short name). + +**Clause order matters.** On DB2 for i, `FOR COLUMN` goes **between the +column name and the data type**, not after the data type. Placing it after +`CHAR(...)` / `VARCHAR(...)` triggers the CCSID-modifier grammar (the parser +expects `FOR BIT DATA` / `FOR SBCS DATA` / `FOR MIXED DATA`) and RUNSQLSTM +fails with `SQL0199: Keyword COLUMN not expected`. + +```sql +CREATE TABLE inventory_master FOR SYSTEM NAME INVMSTR ( + company_code FOR COLUMN COMPCD CHAR(3) NOT NULL, + item_number FOR COLUMN ITEMNO VARCHAR(20) NOT NULL, + ... +) +``` + +## 3. Multi-tenancy — `company_code` + +Every business table is multi-tenant: + +- `company_code CHAR(3) NOT NULL` is the **leading column** of every + composite primary key on a business table. +- Reference tables (UOM, code_master, etc.) may be global, but if a value + is company-scoped, `company_code` leads the PK there too. +- Items are **not** shared across companies — each company gets its own item + numbers. This lets demos show two companies with the same SKU carrying + different attributes. + +## 4. Standard audit block + +Every table carries the same five columns at the end of its column list: + +```sql +created_at FOR COLUMN CRTAT TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP, +created_by FOR COLUMN CRTBY VARCHAR(18) NOT NULL DEFAULT USER, +updated_at FOR COLUMN UPDAT TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP, +updated_by FOR COLUMN UPDBY VARCHAR(18) NOT NULL DEFAULT USER, +is_active FOR COLUMN ISACT CHAR(1) NOT NULL DEFAULT 'Y' +``` + +**Why `VARCHAR(18)` on `_by` columns, not `VARCHAR(10)`.** DB2 for i's `USER` +special register returns `VARCHAR(18)`. If the target column is narrower, +`CREATE TABLE ... DEFAULT USER` fails with `SQL0574: Column, sequence, or +variable attribute is not valid`. IBM i user profiles are still ≤10 chars, so +the extra width is unused padding in practice — but the column must be able +to hold the default the register produces. + +The `CHECK (is_active IN ('Y','N'))` constraint is declared at table level +(as a named `CONSTRAINT`) rather than inline. Named constraints produce +readable messages in DB2 catalog errors and give RPG programs a stable +constraint name to reference. + +RPG maintenance programs stamp `updated_at`/`updated_by` on every write — +`CURRENT_TIMESTAMP` / `USER` are only the safety-net defaults. + +## 5. Referential integrity — declared in DDL + +FKs and CHECK constraints are declared on the table, not enforced in +application code. If a change would violate integrity, we want DB2 to reject +it — full stop. RPG programs must handle the resulting SQLSTATE cleanly. + +- Every FK is `ON DELETE RESTRICT ON UPDATE RESTRICT` unless there is a + specific reason otherwise. Physical deletes are rare — prefer `is_active = + 'N'` for soft delete. +- CHECK constraints enforce enumerations and simple invariants (positive + quantities, `IN (...)` value sets). +- **No `GENERATED ALWAYS AS IDENTITY`** unless the table has no natural key. + In PERP that is only `reconciliation_log`. + +## 6. Composite PKs + +- Business tables: `PRIMARY KEY (company_code, ...natural_key...)` +- Reference tables: `PRIMARY KEY (code_type, code_value)` and similar +- Multi-column PKs are the norm — no surrogate `id INT` columns. + +**Partial (filtered) unique indexes work as `.index.sql` on DB2 for i.** +Confirmed in PERP-28: `CREATE UNIQUE INDEX ... ON tbl (cols) WHERE +predicate` runs clean through `RUNSQLSTM` and produces a normal `*FILE` LF +object. Use this for "at most one flagged row per group" constraints +(e.g. one preferred vendor per item) instead of application-code +enforcement — DB2 rejects the second `WHERE`-matching row with +`SQL0803`/`SQLSTATE 23505` just like any other unique-index violation. + +## 7. Journaling — day-one requirement + +Every table in this module is journaled from the moment it is created. +Departs from `cfdemo/` which runs `SET OPTION COMMIT = *NONE`. + +- Journal receiver: `PERPRCV001` in `PERPDEMO` +- Journal: `PERPJRN` in `PERPDEMO` +- Bootstrap CL: `qclsrc/perpjrn.clle` — creates receiver + journal. Run + once at library setup: `CALL PGM(PERPDEMO/PERPJRN)`. Idempotent + (monitors CPF7010). +- STRJRNPF wrapper: `qclsrc/perpsjpf.clle` — `CALL PERPSJPF PARM('MYTBL')` + attaches a single physical file to `PERPJRN` with `IMAGES(*BOTH) + OMTJRNE(*OPNCLO)`. Call after every new `.table.sql` build. +- RPG programs use real commitment control (`ACTGRP(*NEW)` or a named + activation group; no `COMMIT(*NONE)`). + +## 8. Effective-dated pricing + +Pricing tables use `effective_from` as part of the PK and a nullable +`effective_to`. Current row: `effective_to IS NULL`. Historical rows are +immutable — new prices close the current row and insert a new one. + +## 9. Document numbering + +Doc numbers are integer sequences per `(company_code, doc_type)`: + +```sql +requisition_number FOR COLUMN REQNBR BIGINT NOT NULL, +``` + +A `document_sequence` table holds the high-water mark per company + doc type +(bumped via the `docseq` service program, PERP-19). + +**No computed display column.** An earlier draft of this section showed a +`GENERATED ALWAYS AS (expression)` computed column for demo-friendly display +numbers (e.g. `ACM-PO-000123`). That pattern **does not build on this +target** — confirmed in PERP-33. Every variant tried raised a parser error +pointing at the open paren or the first identifier inside it, with the same +oddly specific hint list (`Valid tokens: . ACCTNG USERID APPLNAME PROGRAMID +WRKSTNNAME`) regardless of what the expression contained: + +| Attempt | Error | +|---|---| +| `company_code CONCAT '-REQ-' CONCAT LPAD(...)` | SQL0199 at the first `CONCAT` | +| `company_code \|\| '-REQ-' \|\| LPAD(...)` | SQL0104 at the first `\|\|` | +| `(company_code)` — bare column reference | SQL0104 at the closing `)` | +| `(UPPER(company_code))` | SQL0104 at `(` after `UPPER` | +| `(tablename.company_code)` | SQL0104, hinted `QSYS2 SYSIBM` | +| IBM's own reference example, `bonus DEC(9,2) GENERATED ALWAYS AS (salary * .10)` | SQL0104 at `*` | + +`GENERATED ALWAYS AS IDENTITY` (no expression) works fine on this target — +only the computed-column expression form fails, on every shape tested. If a +future story needs a demo-friendly display number, build it in RPG/DSPF (or +a view) instead of a generated column; don't re-attempt this in DDL without +budgeting time to re-verify it against whatever DB2 for i PTF/config is live +at the time. + +**Worked example — PO open_qty via a view (PERP-37).** `po_line` needs a +per-row `open_qty = ordered_qty - received_qty` for the browse screen and +receipt allocation. Rather than fight the computed-column parser, the epic +ships a companion view `po_line_open` (`qddlsrc/po_line_open.view.sql`) that +`SELECT ordered_qty - received_qty AS open_qty, ordered_qty * unit_price AS +extended_price ... FROM po_line`. Programs that need the derived columns +join the view; programs that don't read `po_line` directly. Views are +`.view.sql` and build as normal `RUNSQLSTM` → `*FILE` LFs (short name auto- +derives; `po_line_open` came out as `PO_LI00002`, confirmed via `SYSTABLES` +after build — same auto-derivation rule as tables). + +## 10. Generic lookup — `code_master` + +Simple code-and-description lookups (statuses, priorities, roles, approval +sources) live in one `code_master` table keyed on `(code_type, code_value)`. +Business tables reference it via a `GENERATED ALWAYS AS ('POSTATUS')` +column so a real FK still works: + +```sql +status_code FOR COLUMN STCODE VARCHAR(20) NOT NULL, +status_type FOR COLUMN STTYPE VARCHAR(20) NOT NULL DEFAULT 'POSTATUS' + CHECK (status_type = 'POSTATUS'), +FOREIGN KEY (status_type, status_code) + REFERENCES code_master (code_type, code_value) +``` + +**Why `DEFAULT + CHECK` instead of `GENERATED ALWAYS AS ('POSTATUS')`.** DB2 +for i requires the generation expression of a computed column to reference +at least one column of the same table — a bare literal is rejected with +`SQL0104: Token '...' was not valid`. `DEFAULT + CHECK` achieves the same +guarantee (row always carries the discriminator value, cannot be overridden) +and lets the composite FK to `code_master` still be declared cleanly. + +**Exceptions:** UOM and `item_class` keep their own tables because they +carry structural attributes (conversion factors, per-company scope) that +don't fit a global lookup. + +## 11. File header + +Every `.table.sql` file starts with the same header block: + +```sql +-- --------------------------------------------------------------------------- +-- Table: (system name ) +-- Module: perp +-- Purpose: +-- Epic: PERP- +-- --------------------------------------------------------------------------- +``` + +## 12. Build ordering + +Rules.mk expresses FK ordering with normal prerequisites (not order-only): + +```makefile +item.file: qddlsrc/item.table.sql company.file item_class.file uom.file +``` + +A parent table must have been (re-)built before a child that FKs to it. Use +`|` (order-only) for the STRJRNPF hook and other dependencies that shouldn't +trigger a rebuild. + +--- + +## Reference example + +**`qddlsrc/example_reference.table.sql`** in this module demonstrates every +one of these conventions in a single file. When adding a new table, copy that +file, rename it, and edit — don't start from scratch. + +--- + +## 13. RPG / SQLRPGLE conventions + +Style rules that came out of PERP-19 (docseq service program) and the PERP-2 +maintenance programs. These apply to every RPG or SQLRPGLE source under +`perp/qrpglesrc/`. + +- **Modern `**FREE`**, first column of the file — no leading whitespace on + the `**free` directive itself (RPG `RNF0257`/`RNF7503` cascade otherwise). +- **`ctl-opt dftactgrp(*no) actgrp(*new)`** — real activation-group scoping; + no default-actgrp fallback. +- **No `SET OPTION COMMIT = *NONE`.** Every PERP table is journaled, so RPG + runs under real commitment control (`commit(*chg)` — the default of + `CRTSQLRPGI`). Callers issue `EXEC SQL COMMIT` / `ROLLBACK`; leaf modules + don't. +- **Schema-qualified table names** in embedded SQL — `perpdemo.company` etc. + `CRTSQLRPGI` on this environment does not accept `DFTRDBCOL` via the + codermake recipe, and the aitool / SSH invocation paths run outside the + PERPDEMO library list. Hard-qualifying keeps every path working. +- **Host-variable names must not collide with column names.** DB2 for i's + SQLRPGLE precompiler raises `SQL0314` ("host variable X not unique") + when an unqualified `:name` in a WHERE clause matches a column of the + referenced table AND a subprocedure parameter. Prefix parms (`nx_`, `pk_`, + `in_`). +- **Host-variable scope is *module*, not *subprocedure*.** The precompiler + does not respect `dcl-proc` scope when collecting host variables — two + subprocedures with parameter names in common raise `SQL0314`. Give every + subprocedure a distinct prefix. +- **`FROM FINAL TABLE (…)` supports `INSERT` only on DB2 for i V7R4.** + Precompiler rejects `UPDATE`/`DELETE` variants with `SQL0199`. Use + `UPDATE` + subsequent `SELECT` inside the same unit-of-work (row lock is + held under `commit(*chg)`). +- **Service programs**: one prototype `.rpgle` per module, referenced via + `/copy`; explicit `.bnd` export list in `perp/qsrvsrc/`; binding + directory qualifies srvpgm names with `$LIBRARY` so callers do not need + PERPDEMO on their library list at activation time. +- **Data-area handles**: use `dcl-ds NAME dtaara(*lda) len(1024) qualified` + and reserve positions in the LDA — every job has an LDA automatically, so + no runtime `CRTDTAARA` is needed. PERP session state (currently just the + selected company code at positions 1-3) lives in the LDA. +- **The SQLRPGLE precompiler does not accept `:ds(i).field` as a host + variable.** Found in PERP-39 (`poreqr.sqlrpgle`): a WHERE clause of + `and rl.requisition_number = :reqs(i).reqnbr` fails with `SQL0312 + Variable REQS not defined or not usable` and `SQL0104 Token ( not + valid`. Same rule applies to nested DS arrays like + `:plan(v).lines(L).item`. Fix: copy the array element to a plain + scalar host variable (`xReqNbr = reqs(i).reqnbr; ... where + ... = :xReqNbr`). This is why `poreqr` has an `x`-prefixed staging + block near the top of its declarations. +- **`dcl-s` inside a `begsr` subroutine is illegal.** Found in the same + program: local variables declared with `dcl-s` inside a `begsr` block + raise `RNF0724 The statement type is out of sequence for the main + procedure`, because `begsr` runs in the main procedure's scope (not + its own like `dcl-proc`). Hoist all `dcl-s`/`dcl-ds` to the main + declaration section; only executable statements go in a `begsr`. +- **Free-format RPG allows only one statement per line.** Two statements + separated by whitespace on the same line (e.g. + `*in60 = *off; *in61 = *off;`) raise `RNF5508 End of free-format + statement is not blank`. Put each on its own line. +- **`%editc(int : 'X')` returns hex, not decimal.** Every PO number + in `pobrwr`'s first live browse rendered as `0000000000` because + `bsponbr = %editc(rows(i).ponbr : 'X')` — edit code `'X'` is + documented as "hex representation of a zoned decimal", not "plain + string". For displaying a numeric doc-number (PO number, + requisition number, line number) as a plain string, use `%char()`. + Use `%editc` only when you deliberately want an RPG edit-code + formatted output (comma grouping, sign, decimal shift, etc.) and + never `'X'` for business display. + +- **`%subst(varchar : 1 : N)` fails at runtime when `N` exceeds the + current data length, not just when it exceeds the declared max.** + Found in `pobrwr` after the DATFMT fix landed — `bsstat = %subst( + rows(i).stat : 1 : 10)` where `stat` is `VARCHAR(20)` holding + `'OPEN'` (4 chars) raised `RNQ0100 Length or start position is out + of range for the string operation (C G D F)` at runtime, even + though the declared max (20) is well above the requested 10. Same + applies to `%subst(vendor_name : 1 : 25)` when the vendor name + happens to be shorter than 25. + + **Fix:** just use direct assignment from VARCHAR into a fixed CHAR + field. RPG right-pads or truncates automatically — no `%subst` is + needed for "fit into the display field". Use `%subst` only when + you actually need a middle slice, and even then guard with + `%min(%len(...), N)`. Fixed across `pobrwr`, `poreqr`, `poschr` + in one pass; captured here so downstream epics don't repeat it. + +- **Sentinel/filter Date values in embedded SQL must stay within the + job DATFMT range (`*MDY`, 1940-2039, on this env).** The SQL + precompiler generates its intermediate host variables (the ones + named `SQL_00020`, `SQL_00021`, ... that back every `:var` + reference in an EXEC SQL) with `DATFMT(*MDY/)` — the JOB DATFMT, + IGNORING `ctl-opt datfmt(*iso)`. Confirmed by inspecting the + compile listing after the "fix": + + ``` + D SQL_00020 192 199D DATFMT(*MDY/) FFRDT + D SQL_00021 200 207D DATFMT(*MDY/) FTODT + ... + SQL_00020 = FFRDT; //SQL <-- assigns *ISO FFRDT into *MDY SQL_00020 + ``` + + So even when the RPG Date variable's *storage* format is `*ISO` + (thanks to `ctl-opt datfmt(*iso)`), the precompiler-generated host + variable it gets assigned to is `*MDY`, and any value outside + 1940-2039 crashes with `RNQ0114 The year portion of a Date or + Timestamp value is not in the correct range (C G D F)`. Found in + `pobrwr` (browse-filter from/to sentinels), 2026-07-22, after two + earlier fix attempts (adding `:*ISO` to the parse, then + `datfmt(*iso)` to `ctl-opt`) both compiled clean but ran the same + crash at the exact same statement. + + **What works:** + 1. Put `datfmt(*iso)` on `ctl-opt` — sets RPG Date variable + storage to *ISO (0001-9999); needed for anything that assigns + to/from the DSPF's `L DATFMT(*ISO)` fields. + 2. Parse literals with explicit `%date('yyyy-mm-dd' : *ISO)` so + the parse step doesn't use the job DATFMT. + 3. **Keep any Date value that will be assigned to an SQL host + variable within `1940-2039`.** For the pobrwr filter, that + meant swapping `0001-01-01` / `9999-12-31` sentinels for + `1940-01-01` / `2039-12-31` — still functionally "no filter" + for realistic PO dates, but doesn't fail the *MDY range check. + + All three steps are needed; the third is what stopped the runtime + crash for good. If you truly need out-of-range Date values in SQL + (unlikely in PERP), the only escape is to bypass the host-variable + path — use dynamic SQL with the date rendered as a CHAR literal + inside the statement text, or move the Date column comparison out + of the WHERE clause entirely. `%date()` with no args (returns + today) is always safe. +- **A correctly-ranged sentinel default does not protect against a + user blanking the field.** Found in `pobrwr` again, 2026-08-07 + (PERP-89): even with the `1940-2039` sentinel fix above already in + place, clearing the From/To date filter field on screen and + pressing Enter crashes with the identical `RNQ0114`. Blanking a + native DDS `L`-type field does not behave like clearing a character + field — it still produces *some* date value that has to pass the + *MDY range check, and no PERP program currently guards for it. + There is also no equivalent, for a blanked date field, of the + character-filter idiom (`:fstat = '' or ...`) that already lets + `fvnd`/`fbuy`/etc. mean "no filter" — `loadPOs`-style code applies + the date bounds unconditionally. Any optional/filter date field + needs to explicitly detect blank input before it reaches an SQL host + variable and decide what blank should mean (most likely: reapply + the sentinel), rather than assume 5250 will always hand back an + in-range value. +- **Program/module/file object names cap at 10 characters — same as + journal receivers (§7).** Learned again in PERP-32: naming a smoke-test + caller `itmvprcqsmk.sqlrpgle` (11 chars) failed `CRTSQLRPGI` with + `CPD0074: Value 'ITMVPRCQSM' for OBJ exceeds 10 characters` — codermake + does *not* auto-truncate the source basename to fit. Renamed the file + itself to `ivprcqsmk.sqlrpgle` (9 chars). Unlike SQL table/column short + names (§2), there is no separate "system name" escape hatch for RPG + program objects — the source file basename *is* the object name, so it + must fit within 10 chars from the start. + +## 14. DSPF conventions + +- **`DSPSIZ(24 80 *DS3)`** — 5250 24×80 baseline (not 27×132). +- **`SFLPAG`** must be conservative enough to fit the display size minus + header rows minus footer minus one for the `SFLEND(*MORE)` indicator. + `CPD7817` (value on SFLPAG too large) will bite otherwise. `SFLPAG(0007)` + is the safe default this module has been using. +- **Do not repeat file-level command-attention keys on a record** + (`CPD7597` "keyword not allowed at both file and record level"). Declare + `CA03/CA05/CA06/CA12` once at file level. +- **Standard F-key legend on every DSPF**: F3=Exit, F5=Refresh, F6=Add, + F12=Cancel — declared at file level and echoed in the footer line. +- **F12 means "back one screen in this program's own flow," never "end + the program."** Only F3 ends the program and returns to the menu. An + edit/add panel's `EXFMT` should `return` from its subroutine on + `*in12` (unwinding to redisplay the list/caller) — most PERP + programs already get this right for their edit panels (`WRKITMR`, + `WRKIVNR`, `WRKCNVR`, etc.). The mistake is at the *list* level: + `if *in03 or *in12; leave; endif;` on a top-level list/subfile + screen is correct ONLY when that screen is the true entry point of + the flow with nothing earlier to go back to (e.g. `PERPSELR`'s + company picker, or a program's own header-entry screen). Found live + on three programs where a *second* screen in the same flow made + this mistake instead — `reqentr`'s Requisition Lines list (PERP-85), + `poentr`'s Purchase Order Lines list (PERP-94), and `poschr`'s + Schedule list (PERP-95) — each exits straight to the menu on F12 + from a screen that has an obvious "back" target (the header screen), + discarding the user's place even though the parent record is + already saved. Audit every `if *in03 or *in12` in a new or changed + program and ask: is this genuinely screen #1 of the flow? +- **After a terminal action (Submit, Approve, Reject), navigate the + user somewhere useful — don't leave them staring at the now-locked + record.** Two programs `iter`ed back to redisplay the very screen + that had just been locked, with no way to start the next document + without exiting the whole program (`reqentr`'s F8=Submit, PERP-86; + `poentr`'s F8=Submit, PERP-93). Decide, for every finalize action, + what screen the user lands on next (a list of similar documents, or + a fresh entry screen for the same document type), and carry the + confirmation `writeMsg()` forward to whatever screen they land on — + see the `clearMsgs()` ordering note above; don't let it get wiped in + the transition. +- **Message subfile** (`R xMSGSFL` / `R xMSGCTL`) attached at row 24 on + every screen; RPG uses `QMHSNDPM` to post messages. +- **`QMHSNDPM`'s message-key output parameter must be the DDS field bound + to `SFLMSGKEY`** (e.g. `SMSGKEY`), not a separate RPG variable of your + own — even one also named `msgkey`. Found in PERP-34/PERP-35 (`reqentr`/ + `reqaprr`): a `writeMsg` helper passed its own local `msgkey` to + `QMHSNDPM` instead of the DDS field `smsgkey`, so `smsgkey` stayed + uninitialized; the subsequent `WRITE` to the message subfile record then + crashed at runtime (`CPF9999`-class exception, "The call to ended + in error") because the device driver couldn't resolve a message using a + garbage key. Caught only by a live user hitting the very first + `writeMsg` call in a fresh program (the "no company selected" guard) — + it reproduces on *every* call, not just that one path, so a single typo + here breaks every message the program ever shows. Always pass the + record's own `SFLMSGKEY` field, and double-check this any time you + copy the `writeMsg`/`clearMsgs` boilerplate into a new program. +- **`clearMsgs()` must run *before* an action handler's `writeMsg()` + in the same pass, never after.** The standard boilerplate calls + `clearMsgs()` once per loop iteration, ahead of that iteration's own + `EXFMT`, so a message queued during the *previous* pass survives to + be shown on the *next* one. If an F6/F8/etc. handler instead calls + `writeMsg()` and then `iter`s straight back to the top of the loop, + and `clearMsgs()` sits unconditionally at that same top, it wipes + `msgrrn` and clears the message subfile before the next `EXFMT` ever + displays the message the handler just queued — confirmation or error + text is queued and destroyed in the same pass, and the action looks + like it silently did nothing. Found in `wrkivpr` (PERP-74: the + F6=Add-with-blank-item warning never reaches the screen) and + suspected as a contributing factor in `reqaprr` (PERP-87: + Approve/Reject confirmations). `reqentr`'s line-list loop gets this + right — `clearMsgs()` sits *between* the F3/F12 check and the F6/F8 + dispatch, not folded into the very top of the loop after them — use + that ordering as the reference shape when copying the boilerplate. +- **The record format shown alongside (or right before) the message + subfile must have `OVERLAY`**, or displaying/writing it clears the + screen and erases the just-written message subfile before the user + ever sees it. Every PERP work-with screen's primary `SFLCTL` format + has had `OVERLAY` since PERP-3, but a plain (non-subfile) entry screen + — e.g. `reqentd.dspf`'s header-entry format `RHEAD` (PERP-34) — is easy + to miss since there's no subfile keyword nearby as a reminder. Give + every format that gets `WRITE`/`EXFMT`'d `OVERLAY`, subfile or not. +- **A second real subfile in `reqaprr`/`reqaprd.dspf` (list `ASFL`/`ASCTL` + plus a review-detail `ALSFL`/`ALCTL`) reliably crashed live with + "Session or device error occurred in file &1" (`CPF5006`) / an + unmonitored `RNX1255` at `EXFMT ALCTL`, on this environment + (Profound UI Genie, "classic" skin) — across **four** independent, + each-textbook-correct implementations, and the true cause is still + not confirmed. Recorded here in full because the investigation + produced two plausible-looking "root causes" in a row that both + turned out to be wrong once retested live; don't repeat either as a + first assumption. + 1. `ASFL`/`ASCTL` (list) + `ALSFL`/`ALCTL` (detail), format switch + issued from inside the driving `READC asfl` loop — crashed. + 2. Same design, format switch deferred until after the `READC` loop + fully drains — crashed identically. + 3. Detail screen split into a separately called program (`reqapdtl`) + with its own device file, the same pattern `wrkitmr` uses calling + `wrkcnvr`/`wrklotr` — crashed too, cascading errors across both + files. (This attempt did surface one real, unrelated, independently + confirmed DDS compile-time bug, kept below: `SFLDSPCTL` combined + with a below-anchor input field raises `CPD7812`.) + 4. Same two-subfile design as #1, this time built carefully against + the documented `CPF5006`/`RNX1255` failure mode (see + [code400.com](https://code400.com/forum/forum/iseries-programming-languages/rpg-rpgle/7971-session-or-device-error) + and [midrangenews.com](http://www.midrangenews.com/view?id=1788): + the error fires when `SFLDSP` is on but the subfile has 0 rows from + the *device's* perspective, typically because a non-`OVERLAY` + `WRITE` in between cleared the screen) — `OVERLAY` added to every + format including the `RDFOOT` footer, separate `SFLCLR`/`SFLDSP` + indicator pairs per subfile, no `SFLDSPCTL`. This looked like a + confirmed fix (compiled clean, matched every documented rule) and + was reported as such — but a genuine fresh-session live retest by + the user showed the **identical crash at the identical statement**. + The "missing `OVERLAY`" theory is therefore wrong, or at least + incomplete, as an explanation for this specific crash. + Every one of these four is standard, previously-working RPG/DDS — + #4 in particular matches the exact pattern every other PERP work-with + screen (`PERPSELR`, `WRKCMR`, `WRKITMR`, etc.) already uses safely for + a single subfile. The one common thread across every failure is + *two subfiles in this one program*; the one design that has ever + rendered successfully for the user is `reqaprr`'s current shape: + **one real subfile (`ASFL`/`ASCTL`) for the list, and a plain + (non-subfile) `RDETAIL` record for the review/approve screen**, with + up to `MAXDTLLINES` (6) line-item rows represented as individually + named fields (`L1ITEM`/`L1QTY`/`L1UOM`/`L1COST` through `L6...`), each + group conditioned on its own indicator (`*in60`-`*in65`) so an unused + row is genuinely blank rather than a confusing `0.0000` (do not use + indicators as a stand-in for real subfile scrolling in general — this + is a workaround for a shape that is known to fail here, not a new + default pattern to reach for elsewhere). This is a deliberate + deviation from the two-subfile pattern used everywhere else in this + module, kept **only** for `reqaprr`, and it caps review detail at 6 + lines with no scrolling — acceptable for now since requisition line + counts are small, but revisit if that stops being true or if the + underlying cause is ever identified. **Do not re-attempt a second + business subfile in `reqaprr` without an actual interactive retest on + this environment proving it renders** — a clean compile and a + textbook-correct design have both already failed to predict this. + + **Addendum, PERP-87 (2026-08-07):** live testing reports F6=Approve, + F7=Reject, *and* F12 all appearing to return to the menu instead of + back to the `ASFL`/`ASCTL` list, from the current (workaround) + `RDETAIL` design described above. Read in isolation, the RPG source + for all three (`reqaprr.sqlrpgle`'s `reviewReq` subroutine) looks + correct — each just `return`s to the outer loop, which should + redisplay the list, not end the program — so if this reproduces, it + is likely the *same* unconfirmed device-error class documented + above, now apparently reachable on the *return* path out of the + plain `RDETAIL` format rather than only on entry into a second + subfile. That would mean the current workaround has not fully + closed the underlying issue. Needs a live joblog check for an + escape message (`RNX1255`/`CPF5006`-class) at the point of return + before assuming this needs an RPG logic fix — don't spend a + redesign cycle on `reviewReq`'s branching logic until that's ruled + out. +- **A `SFLCTL` record's `SFLDSPCTL` keyword combined with an + input-capable (`B`) field positioned *below* the subfile's anchor row + raises `CPD7812`: "Subfile control record overlaps subfile record"** + at DDS compile time — even though the field's row/col is nowhere near + the subfile's visible `SFLPAG` rows. Confirmed empirically while + building `reqapdtl.dspf` (PERP-35 follow-up): the same field + (`ENOTES2`, an entry field at row 15, well below `SFLPAG(0005)`'s + visible rows 10-14) compiled clean once `SFLDSPCTL` was removed and + the field was repositioned *above* the subfile's anchor row instead. + The overlap check appears to reserve rows through `SFLSIZ` (which can + be much larger than `SFLPAG`, e.g. `50` vs `5` here), not just the + visible page, for any input-capable control-record field, when + `SFLDSPCTL` is present. Fix: position input-capable fields on a + `SFLCTL` record *above* the subfile's anchor row (matching every + other PERP `SFLCTL` record, e.g. `RLCTL` in `reqentd.dspf`, none of + which have `SFLDSPCTL` combined with a below-anchor input field), or + omit `SFLDSPCTL` if it isn't actually needed (it wasn't, here — the + existing `SFLDSP` conditioning indicator already controls visibility). +- **Every numeric field on screen (subfile column or edit-panel field, + input or output) gets `EDTCDE(3)`.** Without an edit code, a zoned + numeric field displays every leading zero (e.g. `000000001500000` for + 150.0000), which is unreadable and reads as an error to anyone glancing + at the screen. `EDTCDE(3)` zero-suppresses and inserts the decimal + point (a no-op if `DEC=0`) while still displaying a literal `0` for a + true zero value — critical for balance/quantity fields where "zero" is + a meaningful, common state (e.g. a freshly-added item's `qty_on_hand`) + that must read as `0`, not blank or a run of zeros. + - **Do not use `EDTCDE(Z)`, `EDTCDE(2)`, `EDTCDE(4)`, or any other + "blank when zero" code for business quantity/balance fields** — those + codes zero-suppress by blanking the field entirely when the value is + zero, which is indistinguishable from "no value" and defeats the + purpose for anything the user needs to read as an explicit zero. + (`Z`/`2`/`4`/`B`/`D`/`K`/`M` blank zero; `1`/`3`/`A`/`C`/`J`/`L` show + it as `0` — this module standardizes on `3`, the plainest of the + zero-showing codes, since these are quantities/counts, not currency + needing comma grouping.) + - Adding `EDTCDE(3)` to a `DEC>0` field grows its display width by + exactly one column (the decimal point) — leave at least that much + headroom between adjacent fields packed onto the same row, or the + compile will overlap/truncate. + - **That one-column allowance is not the whole story — compute the + field's *maximum* rendered width, including comma insertion, + before spacing columns.** `EDTCDE(3)` inserts a comma every 3 + integer digits. A `15Y 4` field (13 integer digits) can render up + to 20 characters wide (13 digits + 4 commas + 1 decimal point + 4 + decimals) — not just "16 digits + 1". Found overlapping in three + places once realistic (larger) values were entered: `pobrwd.dspf`'s + PO Detail line columns (Ord/Rcv/Open/Price only 9-10 columns + apart, PERP-90), `poentd.dspf`'s PO Lines Qty column running into + the UOM column (PERP-92), and `poreqd.dspf`'s Est Cost column + starting at column 73 with a 20-character max width — 12 columns + past the right edge of an 80-column screen, so it silently wraps + onto the next physical row (PERP-97, and suspected of breaking F6 + option detection there since the wrap likely misaligns how the + web renderer maps keystrokes back to the right subfile record). + Work out the worst-case width for every `Y`-type field's digit + count before choosing its column, not just "+1 for the decimal." + - **Right-align the column heading over the field, not over its + start column.** A numeric field's value is right-justified within + its width; a heading positioned at the field's left edge reads as + "too far left" once real data appears (PERP-90, PERP-92, and + `wrkcnvd.dspf`'s Factor heading). Position heading text so it ends + at (or near) the field's rightmost column instead. +- **Never issue `READC` against a subfile that was not written to this + cycle.** If the load routine finds 0 rows this pass (e.g. an empty + filter result, or the "enter a key value to begin" state before any + scoping value has been typed), the subfile-options `READC` loop must + be skipped entirely — guard it with `if numRows > 0; ... endif;`. + Unconditionally issuing `READC` against a subfile that has never been + `WRITE`n this invocation raises a runtime **"Session or device error + occurred in file &1"** (CPF5006-class) the instant the user presses + Enter on an empty list — it does not just return `*EOF` the way a + populated-then-cleared subfile would. Found across every PERP + work-with program (`PERPSELR`, `WRKCMR`, `WRKUSRR`, `WRKUOMR`, + `WRKCNVR`, `WRKICLR`, `WRKITMR`, `WRKLOTR`) since they all share the + same load/fill/read-options skeleton; fixed in all eight at once. + Corollary: if a program skips the load routine entirely when its scope + key is blank (e.g. `WRKCNVR`/`WRKLOTR` before an item number is + entered), explicitly reset the row counter to 0 in that branch too — + otherwise a stale nonzero count from a *previous* scope value lets the + guard pass even though nothing was loaded this cycle. + +## 14a. Location codes are alphanumeric, not numeric ordinals + +`item.aisle_code` / `bay_code` / `shelf_code` (`PERP-3`/`PERP-20`) are free-text +`VARCHAR(10)` columns. Real seed data mixes a letter prefix with the ordinal +(e.g. `'A1'`, `'B2'`, `'S3'` -- confirmed against the `WIDGET1` seed row). +`CAST(aisle_code AS INTEGER)` rejects that outright with `SQL0420`. + +Any service that needs the numeric ordinal out of one of these codes (e.g. +`whcoord`, `PERP-27`) must parse it in RPG rather than casting the whole +string in SQL -- pull out the digit characters and convert those +(`ordinalFromCode()` in `qrpglesrc/whcoord.sqlrpgle` is the reference +implementation). Don't assume these columns hold pure numeric strings. + +## 15. codermake gotchas + +- **`.menu` recipe needs `.file` as a *normal* prerequisite**, not + order-only. `foo.menu: foo.msgf foo.file` builds; `foo.menu: foo.msgf | + foo.file` silently drops the recipe (make says "Nothing to be done" and + the menu is never created). +- **`CRTSQLRPGI` does not accept `DFTRDBCOL` through codermake's compile + options** — the recipe hard-codes its flags. Qualify table references + in RPG source instead of relying on a runtime library list. +- **Binding directory sources** should qualify service-program references + with `$LIBRARY` (`addbnddire … obj(($LIBRARY/mysrvpgm *srvpgm *immed))`) + so activation-time lookup does not depend on the caller's library list. +- **Menu DSPF record format name must match the menu object name.** + `CRTMNU TYPE(*DSPF)` looks for a record format whose name equals the + menu name (e.g. menu `PERPMNU` requires `A R PERPMNU` in the DSPF). + Wrong name compiles fine but calling `GO PERPMNU` fails at runtime with + `Record format for menu definition not found. Problem displaying menu + PERPMNU in library PERPDEMO.` +- **`CRTSRCPF … TEXT(...)` caps at 50 characters** — CPD0074 fires on + longer strings. Keep source-PF text descriptions terse. + +## 16. Source physical files in PERPDEMO + +Every source type used by the module needs a matching source PF on the +IBM i target. `codermake` copies sources into these files at sync time. +Create them once when standing up a new task/build library: + +``` +CRTSRCPF FILE(PERPDEMO/QDDLSRC) RCDLEN(112) TEXT('PERP - SQL DDL source') +CRTSRCPF FILE(PERPDEMO/QDDSSRC) RCDLEN(112) TEXT('PERP - DDS source') +CRTSRCPF FILE(PERPDEMO/QRPGLESRC) RCDLEN(112) TEXT('PERP - RPG ILE / SQLRPGLE') +CRTSRCPF FILE(PERPDEMO/QCLSRC) RCDLEN(112) TEXT('PERP - CL / CLLE source') +CRTSRCPF FILE(PERPDEMO/QSRVSRC) RCDLEN(112) TEXT('PERP - Binder/Service pgm') +CRTSRCPF FILE(PERPDEMO/QMENUSRC) RCDLEN(112) TEXT('PERP - Menu source') +CRTSRCPF FILE(PERPDEMO/QCMDSRC) RCDLEN(112) TEXT('PERP - Command source') +CRTSRCPF FILE(PERPDEMO/QPNLSRC) RCDLEN(112) TEXT('PERP - Panel group source') +CRTSRCPF FILE(PERPDEMO/QSQLSRC) RCDLEN(112) TEXT('PERP - SQL source') +``` + +`QDDLSRC` was missing at PERP-2 initial cutover and was created after +the fact; keep it as part of the PERPDEMO bootstrap for future clones. + +## 16a. A message subfile only updates when its SFLCTL record is re-WRITE'n + +**Toggling the `*in40`-style RPG indicator that conditions `SFLDSP` has no +visible effect unless the `SFLCTL` record itself is `WRITE`'n again** -- +changing the RPG variable is not enough; the device only re-evaluates a +record's conditioning indicators when that specific record is the target +of a `WRITE`/`EXFMT` operation. Found in `rcventr` (PERP-43): the header +validation loop and the `receiveLine` edit-panel loop each set `*in40` +based on `msgrrn` and then `EXFMT`'d a *different* format (`RHEAD` / +`RLEDIT`) without an explicit `WRITE rmsgctl` first. Confirmed live: an +invalid-PO-number error never appeared on screen at all, even though +`writeMsg` had correctly written a row into the message subfile and +`msgrrn` was correctly nonzero. + +Every PERP work-with program's *subfile* loop already gets this right +(`write rlctl` / `write plctl` / `write bsctl` immediately before the +`exfmt` of the same cycle) -- the bug only shows up in a program's +*header entry* or *plain edit-panel* loop, which don't otherwise need to +re-`WRITE` their own record before `EXFMT` (since `EXFMT` both writes and +reads that record). The message subfile control record is a second, +separate record that needs its own explicit `WRITE` every cycle if its +indicators changed, regardless of what other record is being `EXFMT`'d +in that same iteration. + +**Fix:** any loop that both (a) conditionally shows/hides the message +subfile via an indicator and (b) `EXFMT`s a record other than the message +`SFLCTL` itself must `WRITE` the message `SFLCTL` record explicitly, +every iteration, before that `EXFMT` -- not just toggle the indicator +variable. `poentr`'s and `reqentr`'s header-entry loops follow the same +toggle-without-write shape as `rcventr`'s did before this fix and were +likely never live-tested against a failing header validation (PERP-7's +own verification notes cite the AIDEMO-menu-no-cmdline block as the +reason interactive testing was skipped in favor of state-based SQL +checks) -- worth a live retest and matching fix there if anyone is in +that code again, but out of scope to change opportunistically here. + +## 17. CHECK constraints cannot cross tables + +A `CHECK` constraint's expression may only reference columns of the table +being defined — DB2 for i (like every SQL-standard implementation) has no +concept of a cross-table `CHECK`. Found in PERP-42: the ticket for +`po_receipt_line` asked for "if `item.lot_controlled = 'Y'` then +`lot_number IS NOT NULL`", which reads like an ordinary `CHECK` but +`item.lot_controlled` lives on a different table than `lot_number`. There +is no DDL syntax that expresses this — a subquery inside `CHECK` is +rejected outright, and there's no cross-table trigger-like `CHECK` variant +on this platform. + +**Fix: enforce it in the RPG program that inserts the row, not in DDL.** +`rcventr` (PERP-43) looks up `item.lot_controlled` before `INSERT`ing into +`po_receipt_line` and rejects the entry interactively if a lot-controlled +item has no lot number entered. The column itself stays nullable in DDL +(`lot_number` on `po_receipt_line`) — the invariant is real and enforced, +just at the application layer instead of the database layer. This is a +general rule, not specific to lots/receipts: any "if column A on table X +then column B on table Y must be Z" business rule in a future PERP story +needs the same treatment — don't spend time trying to express it as a +table-level `CONSTRAINT` first. + +## 18. Screen-to-source coverage + +Every interactive screen a user can reach should have matching +`.dspf`/`.sqlrpgle` source in this repo — the repo is the source of +truth, and live testing/fixes are only possible for what's actually +checked in here. + +**Found a gap, PERP-98 (2026-08-07):** the live "Receipt Entry" screen +(PO Number, Vendor, PO Status, Receipt Date, Received By, Notes +fields) has no corresponding source anywhere under `qddssrc/` or +`qrpglesrc/` in this module — every other screen exercised during +Phase 2 testing had matching source; this one didn't. Whatever object +is actually running for it was not built from (or was never checked +into) this repo. + +Before treating any live-reported bug as a source-level fix, confirm +the screen's source actually exists here first. If it doesn't, that's +its own finding — flag it rather than guessing at a fix, and don't +pull the live object's source off the IBM i host to fill the gap (see +the top-level environment rules); the gap itself needs a decision +(locate the real source, or write a new one into this repo) before +code work can start. diff --git a/perp/Rules.mk b/perp/Rules.mk new file mode 100644 index 00000000..242b9030 --- /dev/null +++ b/perp/Rules.mk @@ -0,0 +1,387 @@ +# PreSales ERP (PERP) module build rules. +# +# All rules for the /perp module go here. Sources live under: +# qddlsrc/ — SQL DDL (.table.sql, .index.sql, .view.sql, .proc.sql) +# qrpglesrc/ — RPG / SQLRPGLE programs and modules +# qddssrc/ — DSPF / PF / LF / PRTF for the 5250 baseline +# qclsrc/ — CL / CLLE (library setup, journal, hooks) +# +# See perp/DDL_STYLE_GUIDE.md for the SQL DDL conventions this module uses. +# +# Naming: one .sql file per table, snake_case, extension .table.sql so +# codermake maps the source to CRTPF via RUNSQLSTM. Parent tables are declared +# as normal prerequisites of tables that FK to them so the build order is +# correct. + +# --- SQL DDL -------------------------------------------------------------- + +# Style-guide reference table. Not a business table — kept in the build so +# that (a) the codermake .table.sql recipe is exercised on every build, and +# (b) the file can be picked up by new-table authors as a copy-paste starter. +# +# perpsjpf.pgm is declared as an order-only prereq so STRJRNPF is available +# for the post-create step below; the perp journal itself (PERPJRN) must +# already exist (created by CALL PERPJRN — see qclsrc/perpjrn.clle). +example_reference.file: qddlsrc/example_reference.table.sql | perpsjpf.pgm + +# --- PERP-2: Company & System Reference tables --------------------------- +# Multi-tenant root + generic lookup + per-tenant configuration. +# FK order: company is created first; document_sequence, company_config, +# and perp_user follow (perp_user FKs code_master(USERROLE), so +# code_master is a normal prereq). +company.file: qddlsrc/company.table.sql | perpsjpf.pgm +code_master.file: qddlsrc/code_master.table.sql | perpsjpf.pgm +document_sequence.file: qddlsrc/document_sequence.table.sql company.file | perpsjpf.pgm +company_config.file: qddlsrc/company_config.table.sql company.file | perpsjpf.pgm +perp_user.file: qddlsrc/perp_user.table.sql code_master.file | perpsjpf.pgm + + +# --- PERP-20: Inventory Master tables -------------------------------------- +# Core item master. FK order: uom and item_class (both FK company) before +# item; item_uom_conversion and item_lot FK item + uom. +uom.file: qddlsrc/uom.table.sql | perpsjpf.pgm +item_class.file: qddlsrc/item_class.table.sql company.file | perpsjpf.pgm +item.file: qddlsrc/item.table.sql company.file item_class.file uom.file | perpsjpf.pgm +item_uom_conversion.file: qddlsrc/item_uom_conversion.table.sql item.file uom.file | perpsjpf.pgm +item_lot.file: qddlsrc/item_lot.table.sql item.file | perpsjpf.pgm + + +# --- PERP-25: 3D Warehouse Map — warehouse_layout table ------------------- +# One row per company; FKs company. Drives coordinate derivation in whcoord +# (PERP-27) and the maintenance screen in wlmr (PERP-26). +warehouse_layout.file: qddlsrc/warehouse_layout.table.sql company.file | perpsjpf.pgm + + +# --- PERP-19: Document sequence service ---------------------------------- +# Atomic per-(company, doc_type) sequence allocator. Module + srvpgm + bnddir. +docseq.module: qrpglesrc/docseq.sqlrpgle qrpglesrc/docseq_pr.rpgle | company_config.file document_sequence.file +docseq.srvpgm: docseq.module qsrvsrc/docseq.bnd +perp.bnddir: perp.bnddir + +# Smoke-test caller for docseq — CALL PERPDEMO/DOCSEQSMK PARM('ACM' 'PO '). +docseqsmk.pgm: qrpglesrc/docseqsmk.sqlrpgle qrpglesrc/docseq_pr.rpgle docseq.srvpgm | perp.bnddir document_sequence.file + + +# --- PERP-16: Company selection utility ---------------------------------- +# Writes the picked company code to *LDA[1:3] for downstream PERP programs. +perpseld.file: qddssrc/perpseld.dspf +perpselr.pgm: qrpglesrc/perpselr.sqlrpgle qddssrc/perpseld.dspf | perpseld.file company.file + + +# --- PERP-17: Code-master maintenance program ---------------------------- +wrkcmd.file: qddssrc/wrkcmd.dspf +wrkcmr.pgm: qrpglesrc/wrkcmr.sqlrpgle qddssrc/wrkcmd.dspf | wrkcmd.file code_master.file + + +# --- PERP-18: perp_user maintenance program ------------------------------ +wrkusrd.file: qddssrc/wrkusrd.dspf +wrkusrr.pgm: qrpglesrc/wrkusrr.sqlrpgle qddssrc/wrkusrd.dspf | wrkusrd.file perp_user.file code_master.file + + +# --- PERP-21: UOM & UOM conversion maintenance ---------------------------- +wrkuomd.file: qddssrc/wrkuomd.dspf +wrkuomr.pgm: qrpglesrc/wrkuomr.sqlrpgle qddssrc/wrkuomd.dspf | wrkuomd.file uom.file + +# Scoped by *LDA company (perpselr) + item number entered on screen. +wrkcnvd.file: qddssrc/wrkcnvd.dspf +wrkcnvr.pgm: qrpglesrc/wrkcnvr.sqlrpgle qddssrc/wrkcnvd.dspf | wrkcnvd.file item_uom_conversion.file itmprmt.pgm + + +# --- PERP-22: Item class maintenance -------------------------------------- +# Scoped by *LDA company (perpselr). +wrkicld.file: qddssrc/wrkicld.dspf +wrkiclr.pgm: qrpglesrc/wrkiclr.sqlrpgle qddssrc/wrkicld.dspf | wrkicld.file item_class.file + + +# --- PERP-23: Item master maintenance -------------------------------------- +# Scoped by *LDA company (perpselr). Option 6 on the subfile calls wrkcnvr +# pre-scoped to the selected item (dynamic CALL via EXTPGM, not compile-time +# bound -- wrkcnvr.pgm listed as order-only so build order still makes sense). +wrkitmd.file: qddssrc/wrkitmd.dspf +wrkitmr.pgm: qrpglesrc/wrkitmr.sqlrpgle qddssrc/wrkitmd.dspf | wrkitmd.file item.file wrkcnvr.pgm wrklotr.pgm itmprmt.pgm + + +# --- PERP-24: Item lot maintenance & inquiry -------------------------------- +# Scoped by *LDA company (perpselr) + item number entered on screen, same +# idiom as wrkcnvr. Discrepancy indicator: item.qty_on_hand vs +# SUM(item_lot.qty_on_hand) for the scoped item. +wrklotd.file: qddssrc/wrklotd.dspf +wrklotr.pgm: qrpglesrc/wrklotr.sqlrpgle qddssrc/wrklotd.dspf | wrklotd.file item_lot.file itmprmt.pgm + + +# --- PERP-27: Warehouse coordinate query service -------------------------- +# Iterator service program: located items in a company joined with x/y/z +# coordinates derived from warehouse_layout. Module + srvpgm + bnddir. +whcoord.module: qrpglesrc/whcoord.sqlrpgle qrpglesrc/whcoord_pr.rpgle | item.file warehouse_layout.file +whcoord.srvpgm: whcoord.module qsrvsrc/whcoord.bnd + +# Smoke-test caller -- CALL PERPDEMO/WHCOORDSMK PARM('ACM'). +whcoordsmk.pgm: qrpglesrc/whcoordsmk.sqlrpgle qrpglesrc/whcoord_pr.rpgle whcoord.srvpgm | perp.bnddir item.file warehouse_layout.file + + +# --- PERP-26: Warehouse layout maintenance -------------------------------- +# Single-record display + edit of warehouse_layout, scoped by *LDA company +# (perpselr). No subfile list -- one row per company. +wlmd.file: qddssrc/wlmd.dspf +wlmr.pgm: qrpglesrc/wlmr.sqlrpgle qddssrc/wlmd.dspf | wlmd.file warehouse_layout.file + + +# --- PERP-28: Vendor, Item-Vendor, Pricing tables -------------------------- +# FK order: vendor (company, perp_user, code_master) before item_vendor +# (item, vendor) before item_vendor_price (item_vendor, code_master). +# The partial-unique preferred-vendor index is a separate .index.sql object, +# a normal (not order-only) prereq of item_vendor so it always rebuilds +# alongside the table it indexes. +vendor.file: qddlsrc/vendor.table.sql company.file perp_user.file code_master.file | perpsjpf.pgm +item_vendor.file: qddlsrc/item_vendor.table.sql item.file vendor.file | perpsjpf.pgm +item_vendor_preferred_ak.file: qddlsrc/item_vendor_preferred_ak.index.sql item_vendor.file +item_vendor_price.file: qddlsrc/item_vendor_price.table.sql item_vendor.file code_master.file | perpsjpf.pgm + + +# --- PERP-51: Standard, reusable Item/Vendor Number prompt programs ------ +# Field-level "?" + Enter lookup, callable from any screen with a keyable +# Item Number or Vendor field via a plain dynamic CALL (EXTPGM prototype +# declared in each caller) -- same idiom wrkitmr already uses to call +# wrkcnvr/wrklotr. Not bound service programs, so no bnddir/exports. +itmprm2d.file: qddssrc/itmprm2d.dspf +itmprmt.pgm: qrpglesrc/itmprmt.sqlrpgle qddssrc/itmprm2d.dspf | itmprm2d.file item.file + +vndprmtd.file: qddssrc/vndprmtd.dspf +vndprmt.pgm: qrpglesrc/vndprmt.sqlrpgle qddssrc/vndprmtd.dspf | vndprmtd.file vendor.file + + +# --- PERP-29: Vendor master maintenance ----------------------------------- +# Scoped by *LDA company (perpselr). Subfile filters by active-only and +# buyer_code. +wrkvndd.file: qddssrc/wrkvndd.dspf +wrkvndr.pgm: qrpglesrc/wrkvndr.sqlrpgle qddssrc/wrkvndd.dspf | wrkvndd.file vendor.file perp_user.file code_master.file + + +# --- PERP-30: Item-vendor profile maintenance ----------------------------- +# Scoped by *LDA company (perpselr) plus an item OR vendor entered on +# screen (item wins if both are entered). +wrkivnd.file: qddssrc/wrkivnd.dspf +wrkivnr.pgm: qrpglesrc/wrkivnr.sqlrpgle qddssrc/wrkivnd.dspf | wrkivnd.file item_vendor.file itmprmt.pgm vndprmt.pgm + + +# --- PERP-31: Item-vendor price maintenance (effective-dated) -------------- +# Scoped by *LDA company (perpselr) plus an item AND vendor entered on +# screen. Read-only history list; F6=Add closes the current row and +# inserts a new one dated today. +wrkivpd.file: qddssrc/wrkivpd.dspf +wrkivpr.pgm: qrpglesrc/wrkivpr.sqlrpgle qddssrc/wrkivpd.dspf | wrkivpd.file item_vendor_price.file itmprmt.pgm vndprmt.pgm + + +# --- PERP-32: Pricing history query service -------------------------------- +# View joins item_vendor_price + vendor; module/srvpgm/bnddir/prototype +# follow the docseq (PERP-19) pattern. Smoke-test caller proves binding. +item_vendor_price_history.file: qddlsrc/item_vendor_price_history.view.sql item_vendor_price.file vendor.file +itmvprcq.module: qrpglesrc/itmvprcq.sqlrpgle qrpglesrc/itmvprcq_pr.rpgle | item_vendor_price_history.file +itmvprcq.srvpgm: itmvprcq.module qsrvsrc/itmvprcq.bnd +# perp.bnddir target already declared above (PERP-19 docseq section); +# adding a new addbnddire entry there for itmvprcq is enough. + +# Smoke-test caller for itmvprcq -- CALL PERPDEMO/IVPRCQSMK PARM('ACM' 'WIDGET1'). +# Named ivprcqsmk, not itmvprcqsmk (11 chars) -- IBM i object names cap at 10. +ivprcqsmk.pgm: qrpglesrc/ivprcqsmk.sqlrpgle qrpglesrc/itmvprcq_pr.rpgle itmvprcq.srvpgm | perp.bnddir item_vendor_price_history.file + + +# --- PERP-6: Requisitioning — requisition_header / requisition_line ------- +# FK order: requisition_header (company, perp_user, code_master -- all +# already built in PERP-2) before requisition_line (requisition_header, +# item, uom). +requisition_header.file: qddlsrc/requisition_header.table.sql company.file perp_user.file code_master.file | perpsjpf.pgm +requisition_line.file: qddlsrc/requisition_line.table.sql requisition_header.file item.file uom.file | perpsjpf.pgm + +# Requisition entry program (header + line subfile). Calls docseq_next('REQ') +# for numbering; defaults line UOM from item, est_unit_cost from the +# preferred vendor's current item_vendor_price row. +reqentd.file: qddssrc/reqentd.dspf +reqentr.pgm: qrpglesrc/reqentr.sqlrpgle qrpglesrc/docseq_pr.rpgle qddssrc/reqentd.dspf | reqentd.file perp.bnddir requisition_header.file requisition_line.file item.file item_vendor.file item_vendor_price.file uom.file perp_user.file itmprmt.pgm + +# Requisition approval program (list of SUBMITTED reqs -> detail w/ up to +# 6 lines as plain fields + confidence badge -> Approve/Reject stamping +# approved_by/approved_at/approval_source=HUMAN/approval_notes). Detail +# is a single plain (non-subfile) record in this SAME file/program -- +# two earlier designs (a second SFLCTL subfile in this file; a separate +# called program with its own device file) both crashed at runtime with +# "Session or device error" the moment the detail screen was reached, +# even though both compiled clean and matched seemingly-reasonable RPG +# patterns. This shape -- one subfile (ASFL) plus plain output/entry +# fields, all in one program -- is the simplest one that's actually +# proven not to crash (matches reqentr's own header/line-edit panels). +reqaprd.file: qddssrc/reqaprd.dspf +reqaprr.pgm: qrpglesrc/reqaprr.sqlrpgle qddssrc/reqaprd.dspf | reqaprd.file requisition_header.file requisition_line.file + +# CoderFlow auto-approval hook. Skeleton service program: no-op scorer, +# reads company_config thresholds, auto-approves (status/approved_by= +# CODERFLOW/approved_at/approval_source_code=CODERFLOW/approval_notes) +# when both the confidence and total-cost thresholds pass. Module + +# srvpgm + bnddir + prototype, same pattern as docseq (PERP-19). +reqauto.module: qrpglesrc/reqauto.sqlrpgle qrpglesrc/reqauto_pr.rpgle | requisition_header.file company_config.file +reqauto.srvpgm: reqauto.module qsrvsrc/reqauto.bnd +# perp.bnddir target already declared above (PERP-19 docseq section); +# adding a new addbnddire entry there for reqauto is enough. + +# Smoke-test caller for reqauto -- CALL PERPDEMO/REQAUTOSMK PARM('ACM' '3 '). +reqautosmk.pgm: qrpglesrc/reqautosmk.sqlrpgle qrpglesrc/reqauto_pr.rpgle reqauto.srvpgm | perp.bnddir requisition_header.file + + +# --- PERP-7: Purchasing — po_header / po_line / po_line_schedule --------- +# FK order: po_header (company, vendor, perp_user (buyer), code_master) +# before po_line (po_header, item, uom, code_master, requisition_line for +# optional back-link) before po_line_schedule (po_line). The po_line_open +# view (ordered_qty - received_qty computed via view rather than a stored +# GENERATED ALWAYS AS column — see DDL_STYLE_GUIDE.md Sec.9) hangs off +# po_line as a normal (not order-only) prereq so it always rebuilds +# alongside its base table. +po_header.file: qddlsrc/po_header.table.sql company.file vendor.file perp_user.file code_master.file | perpsjpf.pgm +po_line.file: qddlsrc/po_line.table.sql po_header.file item.file uom.file code_master.file requisition_line.file | perpsjpf.pgm +po_line_schedule.file: qddlsrc/po_line_schedule.table.sql po_line.file | perpsjpf.pgm +po_line_open.file: qddlsrc/po_line_open.view.sql po_line.file + +# Manual PO entry program (header + line subfile). Calls docseq_next('PO') +# for numbering; snapshots buyer_code from vendor at header commit; +# defaults line UOM from item, unit_price from the entered vendor's +# current item_vendor_price row. Same shape as reqentr (PERP-34). +poentd.file: qddssrc/poentd.dspf +poentr.pgm: qrpglesrc/poentr.sqlrpgle qrpglesrc/docseq_pr.rpgle qddssrc/poentd.dspf | poentd.file perp.bnddir po_header.file po_line.file item.file item_vendor.file item_vendor_price.file uom.file vendor.file perp_user.file itmprmt.pgm vndprmt.pgm + +# PO from requisition (consolidate/split). Selects APPROVED requisitions, +# groups their lines by preferred vendor (one PO per vendor -> splitting), +# consolidates multiple selected reqs into a single PO per vendor. Each +# generated po_line carries source_requisition_number + +# source_requisition_line_number so "converted" status is derivable by +# joining po_line back to requisition_line's PK. Approved reqs flip to +# CONVERTED once all their lines have been placed on a PO. +poreqd.file: qddssrc/poreqd.dspf +poreqr.pgm: qrpglesrc/poreqr.sqlrpgle qrpglesrc/docseq_pr.rpgle qddssrc/poreqd.dspf | poreqd.file perp.bnddir po_header.file po_line.file requisition_header.file requisition_line.file item_vendor.file item_vendor_price.file vendor.file + +# Blanket PO schedule maintenance. Subfile of po_line_schedule rows for +# a given (company, po_number, line_number). Add/Change/Delete rows. +# Warn (not block) when total scheduled_qty exceeds po_line.ordered_qty. +poschd.file: qddssrc/poschd.dspf +poschr.pgm: qrpglesrc/poschr.sqlrpgle qddssrc/poschd.dspf | poschd.file po_line.file po_line_schedule.file + +# PO browse & inquiry. Filterable subfile of PO headers (status, vendor, +# buyer, order-date range); Option 5 drills to detail (header + all +# lines, joined to po_line_open for open_qty + extended_price); Option 8 +# on a line drills to source requisition (if any) + schedule (if blanket). +pobrwd.file: qddssrc/pobrwd.dspf +pobrwr.pgm: qrpglesrc/pobrwr.sqlrpgle qddssrc/pobrwd.dspf | pobrwd.file po_header.file po_line.file po_line_open.file po_line_schedule.file requisition_line.file vendor.file perp_user.file + + +# --- PERP-8: Receiving & Reconciliation ----------------------------------- +# FK order: po_receipt (company, po_header, perp_user, code_master) before +# po_receipt_line (po_receipt, po_line, item). reconciliation_log FKs item +# only (no natural key -- IDENTITY surrogate, see DDL_STYLE_GUIDE.md Sec.5). +po_receipt.file: qddlsrc/po_receipt.table.sql company.file po_header.file perp_user.file code_master.file | perpsjpf.pgm +po_receipt_line.file: qddlsrc/po_receipt_line.table.sql po_receipt.file po_line.file item.file | perpsjpf.pgm +reconciliation_log.file: qddlsrc/reconciliation_log.table.sql item.file | perpsjpf.pgm + +# PO receipt entry program (header + open-lines subfile). Calls +# docseq_next('RCP') for numbering; header is POSTED immediately (no DRAFT +# workflow -- adding a receipt line IS the act of receiving). Per-line +# action is subfile Option 1=Receive (not F6=Add) -- every receipt line +# originates from an existing open po_line, unlike poentr/reqentr where F6 +# creates a brand-new row from nothing; option-based selection matches +# poentr's own 2=Change/4=Delete and pobrwr's 5=Detail/9=Schedule idiom for +# actions against an existing row. Converts vendor UOM -> inventory UOM via +# item_uom_conversion, upserts item_lot for lot-controlled items, rolls +# po_line.received_qty/status_code and po_header.status_code forward -- +# the PO-status-transition-from-receipts follow-up PERP-7's recap deferred +# to this epic. +rcventd.file: qddssrc/rcventd.dspf +rcventr.pgm: qrpglesrc/rcventr.sqlrpgle qrpglesrc/docseq_pr.rpgle qddssrc/rcventd.dspf | rcventd.file perp.bnddir po_receipt.file po_receipt_line.file po_header.file po_line.file item.file item_uom_conversion.file item_lot.file perp_user.file uom.file poprmt.pgm + +# --- PERP-51/PERP-98: standard, reusable PO Number prompt (rcventr) ----- +poprmtd.file: qddssrc/poprmtd.dspf +poprmt.pgm: qrpglesrc/poprmt.sqlrpgle qddssrc/poprmtd.dspf | poprmtd.file po_header.file vendor.file + +# Lot reconciliation service. Module + srvpgm + bnddir, same pattern as +# docseq/itmvprcq/whcoord/reqauto. Scans lot-controlled items for one +# company, compares item.qty_on_hand to SUM(item_lot.qty_on_hand), logs +# and repairs (lot is the source of truth) any drift to reconciliation_log. +lotrecon.module: qrpglesrc/lotrecon.sqlrpgle qrpglesrc/lotrecon_pr.rpgle | item.file item_lot.file reconciliation_log.file +lotrecon.srvpgm: lotrecon.module qsrvsrc/lotrecon.bnd +# perp.bnddir target already declared above (PERP-19 docseq section); +# adding a new addbnddire entry there for lotrecon is enough. + +# Smoke-test caller for lotrecon -- CALL PERPDEMO/LOTRCNSMK PARM('ACM' 'CODERFLOW '). +lotrcnsmk.pgm: qrpglesrc/lotrcnsmk.sqlrpgle qrpglesrc/lotrecon_pr.rpgle lotrecon.srvpgm | perp.bnddir item.file item_lot.file reconciliation_log.file + +# Reconciliation log browse & inquiry. Filterable subfile (item, reconciled +# by, date range on run_timestamp); Option 5 drills to a plain-record +# detail showing before/after values + notes. No F6=Add -- this table is +# populated exclusively by lotrecon, never by hand (same reasoning pobrwd +# already applies: browse-only screens in this module omit F6). +rcnbrwd.file: qddssrc/rcnbrwd.dspf +rcnbrwr.pgm: qrpglesrc/rcnbrwr.sqlrpgle qddssrc/rcnbrwd.dspf | rcnbrwd.file reconciliation_log.file item.file + + +# --- PERP menus (glue for exploratory verification) ----------------------- +# GO PERPDEMO/PERPMNU is the single entry point. PERPMNU itself only holds +# "Select company" + one option per child menu + Sign off -- the child +# menus group the actual maintenance/diagnostic programs so the top level +# doesn't grow one line per story as new epics land (PERP-6/7/8 +# Requisitioning/Purchasing/Receiving will each get their own child menu +# under PERPMNU the same way, instead of more top-level numbers). +# +# .file MUST be a normal prereq (not order-only) or codermake silently drops +# the CRTMNU recipe. See DDL_STYLE_GUIDE § "codermake menu gotcha" -- this +# bit cfdemo/menu.menu too (fixed there in the same commit as this section). + +# PERP-16/17/18: company selector + system maintenance (code_master, users) +perpsysm.file: qddssrc/perpsysm.dspf +perpsysm.msgf: perpsysm.msgf +perpsysm.menu: perpsysm.msgf perpsysm.file | wrkcmr.pgm wrkusrr.pgm + +# PERP-20/21/22/23/24/26: inventory master data (+ warehouse layout, PERP-4) +perpinvm.file: qddssrc/perpinvm.dspf +perpinvm.msgf: perpinvm.msgf +perpinvm.menu: perpinvm.msgf perpinvm.file | wrkuomr.pgm wrkcnvr.pgm wrkiclr.pgm wrkitmr.pgm wrklotr.pgm wlmr.pgm + +# PERP-28/29/30/31: vendor & pricing master data +perpvndm.file: qddssrc/perpvndm.dspf +perpvndm.msgf: perpvndm.msgf +perpvndm.menu: perpvndm.msgf perpvndm.file | wrkvndr.pgm wrkivnr.pgm wrkivpr.pgm + +# PERP-19/27/32: service-program smoke testers +perpdiag.file: qddssrc/perpdiag.dspf +perpdiag.msgf: perpdiag.msgf +perpdiag.menu: perpdiag.msgf perpdiag.file | docseqsmk.pgm ivprcqsmk.pgm whcoordsmk.pgm reqautosmk.pgm lotrcnsmk.pgm + +# PERP-6/7/8: Requisitioning / Purchasing / Receiving each get their own +# child menu under PERPMNU (see codermake menu note below). PERP-34 adds +# option 1 (reqentr); PERP-35 adds option 2 (reqaprr) once it lands. +perpreqm.file: qddssrc/perpreqm.dspf +perpreqm.msgf: perpreqm.msgf +perpreqm.menu: perpreqm.msgf perpreqm.file | reqentr.pgm reqaprr.pgm + +# PERP-7 Purchasing child menu. Options: 1 manual PO (poentr), 2 PO from +# requisition (poreqr), 3 blanket schedule (poschr), 4 browse/inquiry +# (pobrwr). +perppom.file: qddssrc/perppom.dspf +perppom.msgf: perppom.msgf +perppom.menu: perppom.msgf perppom.file | poentr.pgm poreqr.pgm poschr.pgm pobrwr.pgm + +# PERP-8 Receiving child menu. Option 1 (rcventr, PERP-43), option 2 +# (rcnbrwr, reconciliation log browse, PERP-45). +perprcvm.file: qddssrc/perprcvm.dspf +perprcvm.msgf: perprcvm.msgf +perprcvm.menu: perprcvm.msgf perprcvm.file | rcventr.pgm rcnbrwr.pgm + +# Top-level menu. Order-only on perpselr.pgm (called directly) and on the +# 7 child .menu targets (routed to via GO PERPDEMO/, not CALLed). +perpmnu.file: qddssrc/perpmnu.dspf +perpmnu.msgf: perpmnu.msgf +perpmnu.menu: perpmnu.msgf perpmnu.file | perpselr.pgm perpsysm.menu perpinvm.menu perpvndm.menu perpdiag.menu perpreqm.menu perppom.menu perprcvm.menu + + +# --- CL setup ------------------------------------------------------------- + +# PERP journal + receiver bootstrap. Run once at library setup time. +perpjrn.pgm: qclsrc/perpjrn.clle + +# STRJRNPF wrapper called after each SQL table create. +perpsjpf.pgm: qclsrc/perpsjpf.clle diff --git a/perp/build/PERPDEMO.lib b/perp/build/PERPDEMO.lib new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/code_master.file b/perp/build/code_master.file new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/company.file b/perp/build/company.file new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/company_config.file b/perp/build/company_config.file new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/document_sequence.file b/perp/build/document_sequence.file new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/example_reference.file b/perp/build/example_reference.file new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/item.file b/perp/build/item.file new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/item_class.file b/perp/build/item_class.file new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/item_lot.file b/perp/build/item_lot.file new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/item_uom_conversion.file b/perp/build/item_uom_conversion.file new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/item_vendor.file b/perp/build/item_vendor.file new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/item_vendor_preferred_ak.file b/perp/build/item_vendor_preferred_ak.file new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/item_vendor_price.file b/perp/build/item_vendor_price.file new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/item_vendor_price_history.file b/perp/build/item_vendor_price_history.file new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/itmprm2d.file b/perp/build/itmprm2d.file new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/itmprmt.pgm b/perp/build/itmprmt.pgm new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/perp.bnddir b/perp/build/perp.bnddir new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/perp_user.file b/perp/build/perp_user.file new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/perpseld.file b/perp/build/perpseld.file new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/perpselr.pgm b/perp/build/perpselr.pgm new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/perpsjpf.pgm b/perp/build/perpsjpf.pgm new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/po_header.file b/perp/build/po_header.file new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/po_line.file b/perp/build/po_line.file new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/po_line_open.file b/perp/build/po_line_open.file new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/po_line_schedule.file b/perp/build/po_line_schedule.file new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/po_receipt.file b/perp/build/po_receipt.file new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/po_receipt_line.file b/perp/build/po_receipt_line.file new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/pobrwd.file b/perp/build/pobrwd.file new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/pobrwr.pgm b/perp/build/pobrwr.pgm new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/poentd.file b/perp/build/poentd.file new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/poentr.pgm b/perp/build/poentr.pgm new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/poprmt.pgm b/perp/build/poprmt.pgm new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/poprmtd.file b/perp/build/poprmtd.file new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/poreqd.file b/perp/build/poreqd.file new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/poreqr.pgm b/perp/build/poreqr.pgm new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/poschd.file b/perp/build/poschd.file new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/poschr.pgm b/perp/build/poschr.pgm new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/rcventd.file b/perp/build/rcventd.file new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/rcventr.pgm b/perp/build/rcventr.pgm new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/reconciliation_log.file b/perp/build/reconciliation_log.file new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/reqaprd.file b/perp/build/reqaprd.file new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/reqaprr.pgm b/perp/build/reqaprr.pgm new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/reqentd.file b/perp/build/reqentd.file new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/reqentr.pgm b/perp/build/reqentr.pgm new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/requisition_header.file b/perp/build/requisition_header.file new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/requisition_line.file b/perp/build/requisition_line.file new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/uom.file b/perp/build/uom.file new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/vendor.file b/perp/build/vendor.file new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/vndprmt.pgm b/perp/build/vndprmt.pgm new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/vndprmtd.file b/perp/build/vndprmtd.file new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/warehouse_layout.file b/perp/build/warehouse_layout.file new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/wlmd.file b/perp/build/wlmd.file new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/wlmr.pgm b/perp/build/wlmr.pgm new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/wrkcmd.file b/perp/build/wrkcmd.file new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/wrkcmr.pgm b/perp/build/wrkcmr.pgm new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/wrkcnvd.file b/perp/build/wrkcnvd.file new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/wrkcnvr.pgm b/perp/build/wrkcnvr.pgm new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/wrkicld.file b/perp/build/wrkicld.file new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/wrkiclr.pgm b/perp/build/wrkiclr.pgm new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/wrkitmd.file b/perp/build/wrkitmd.file new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/wrkitmr.pgm b/perp/build/wrkitmr.pgm new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/wrkivnd.file b/perp/build/wrkivnd.file new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/wrkivnr.pgm b/perp/build/wrkivnr.pgm new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/wrkivpd.file b/perp/build/wrkivpd.file new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/wrkivpr.pgm b/perp/build/wrkivpr.pgm new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/wrklotd.file b/perp/build/wrklotd.file new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/wrklotr.pgm b/perp/build/wrklotr.pgm new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/wrkuomd.file b/perp/build/wrkuomd.file new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/wrkuomr.pgm b/perp/build/wrkuomr.pgm new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/wrkusrd.file b/perp/build/wrkusrd.file new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/wrkusrr.pgm b/perp/build/wrkusrr.pgm new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/wrkvndd.file b/perp/build/wrkvndd.file new file mode 100644 index 00000000..e69de29b diff --git a/perp/build/wrkvndr.pgm b/perp/build/wrkvndr.pgm new file mode 100644 index 00000000..e69de29b diff --git a/perp/perp.bnddir b/perp/perp.bnddir new file mode 100644 index 00000000..2ac25477 --- /dev/null +++ b/perp/perp.bnddir @@ -0,0 +1,6 @@ +crtbnddir bnddir($LIBRARY/$NAME) +addbnddire bnddir($LIBRARY/$NAME) obj(($LIBRARY/docseq *srvpgm *immed)) +addbnddire bnddir($LIBRARY/$NAME) obj(($LIBRARY/itmvprcq *srvpgm *immed)) +addbnddire bnddir($LIBRARY/$NAME) obj(($LIBRARY/whcoord *srvpgm *immed)) +addbnddire bnddir($LIBRARY/$NAME) obj(($LIBRARY/reqauto *srvpgm *immed)) +addbnddire bnddir($LIBRARY/$NAME) obj(($LIBRARY/lotrecon *srvpgm *immed)) diff --git a/perp/perpdiag.msgf b/perp/perpdiag.msgf new file mode 100644 index 00000000..66847a16 --- /dev/null +++ b/perp/perpdiag.msgf @@ -0,0 +1,6 @@ +crtmsgf msgf($LIBRARY/$NAME) +addmsgd msgid(usr0001) msgf($LIBRARY/$NAME) msg('call docseqsmk parm(''ACM'' ''PO '')') seclvl(*none) sev(00) fmt(*none) +addmsgd msgid(usr0002) msgf($LIBRARY/$NAME) msg('call ivprcqsmk parm(''ACM'' ''WIDGET1'')') seclvl(*none) sev(00) fmt(*none) +addmsgd msgid(usr0003) msgf($LIBRARY/$NAME) msg('call whcoordsmk parm(''ACM'')') seclvl(*none) sev(00) fmt(*none) +addmsgd msgid(usr0004) msgf($LIBRARY/$NAME) msg('call reqautosmk parm(''ACM'' ''3 '')') seclvl(*none) sev(00) fmt(*none) +addmsgd msgid(usr0005) msgf($LIBRARY/$NAME) msg('call lotrcnsmk parm(''ACM'' ''CODERFLOW '')') seclvl(*none) sev(00) fmt(*none) diff --git a/perp/perpinvm.msgf b/perp/perpinvm.msgf new file mode 100644 index 00000000..56a4c2b9 --- /dev/null +++ b/perp/perpinvm.msgf @@ -0,0 +1,7 @@ +crtmsgf msgf($LIBRARY/$NAME) +addmsgd msgid(usr0001) msgf($LIBRARY/$NAME) msg('call wrkuomr') seclvl(*none) sev(00) fmt(*none) +addmsgd msgid(usr0002) msgf($LIBRARY/$NAME) msg('call wrkcnvr') seclvl(*none) sev(00) fmt(*none) +addmsgd msgid(usr0003) msgf($LIBRARY/$NAME) msg('call wrkiclr') seclvl(*none) sev(00) fmt(*none) +addmsgd msgid(usr0004) msgf($LIBRARY/$NAME) msg('call wrkitmr') seclvl(*none) sev(00) fmt(*none) +addmsgd msgid(usr0005) msgf($LIBRARY/$NAME) msg('call wrklotr') seclvl(*none) sev(00) fmt(*none) +addmsgd msgid(usr0006) msgf($LIBRARY/$NAME) msg('call wlmr') seclvl(*none) sev(00) fmt(*none) diff --git a/perp/perpmnu.msgf b/perp/perpmnu.msgf new file mode 100644 index 00000000..973a43e2 --- /dev/null +++ b/perp/perpmnu.msgf @@ -0,0 +1,10 @@ +crtmsgf msgf($LIBRARY/$NAME) +addmsgd msgid(usr0001) msgf($LIBRARY/$NAME) msg('call perpselr') seclvl(*none) sev(00) fmt(*none) +addmsgd msgid(usr0002) msgf($LIBRARY/$NAME) msg('go perpdemo/perpsysm') seclvl(*none) sev(00) fmt(*none) +addmsgd msgid(usr0003) msgf($LIBRARY/$NAME) msg('go perpdemo/perpinvm') seclvl(*none) sev(00) fmt(*none) +addmsgd msgid(usr0004) msgf($LIBRARY/$NAME) msg('go perpdemo/perpvndm') seclvl(*none) sev(00) fmt(*none) +addmsgd msgid(usr0005) msgf($LIBRARY/$NAME) msg('go perpdemo/perpdiag') seclvl(*none) sev(00) fmt(*none) +addmsgd msgid(usr0006) msgf($LIBRARY/$NAME) msg('go perpdemo/perpreqm') seclvl(*none) sev(00) fmt(*none) +addmsgd msgid(usr0007) msgf($LIBRARY/$NAME) msg('go perpdemo/perppom') seclvl(*none) sev(00) fmt(*none) +addmsgd msgid(usr0008) msgf($LIBRARY/$NAME) msg('go perpdemo/perprcvm') seclvl(*none) sev(00) fmt(*none) +addmsgd msgid(usr0090) msgf($LIBRARY/$NAME) msg('signoff') seclvl(*none) sev(00) fmt(*none) diff --git a/perp/perppom.msgf b/perp/perppom.msgf new file mode 100644 index 00000000..b303fb35 --- /dev/null +++ b/perp/perppom.msgf @@ -0,0 +1,5 @@ +crtmsgf msgf($LIBRARY/$NAME) +addmsgd msgid(usr0001) msgf($LIBRARY/$NAME) msg('call poentr') seclvl(*none) sev(00) fmt(*none) +addmsgd msgid(usr0002) msgf($LIBRARY/$NAME) msg('call poreqr') seclvl(*none) sev(00) fmt(*none) +addmsgd msgid(usr0003) msgf($LIBRARY/$NAME) msg('call poschr') seclvl(*none) sev(00) fmt(*none) +addmsgd msgid(usr0004) msgf($LIBRARY/$NAME) msg('call pobrwr') seclvl(*none) sev(00) fmt(*none) diff --git a/perp/perprcvm.msgf b/perp/perprcvm.msgf new file mode 100644 index 00000000..47afa538 --- /dev/null +++ b/perp/perprcvm.msgf @@ -0,0 +1,3 @@ +crtmsgf msgf($LIBRARY/$NAME) +addmsgd msgid(usr0001) msgf($LIBRARY/$NAME) msg('call rcventr') seclvl(*none) sev(00) fmt(*none) +addmsgd msgid(usr0002) msgf($LIBRARY/$NAME) msg('call rcnbrwr') seclvl(*none) sev(00) fmt(*none) diff --git a/perp/perpreqm.msgf b/perp/perpreqm.msgf new file mode 100644 index 00000000..be611595 --- /dev/null +++ b/perp/perpreqm.msgf @@ -0,0 +1,3 @@ +crtmsgf msgf($LIBRARY/$NAME) +addmsgd msgid(usr0001) msgf($LIBRARY/$NAME) msg('call reqentr') seclvl(*none) sev(00) fmt(*none) +addmsgd msgid(usr0002) msgf($LIBRARY/$NAME) msg('call reqaprr') seclvl(*none) sev(00) fmt(*none) diff --git a/perp/perpsysm.msgf b/perp/perpsysm.msgf new file mode 100644 index 00000000..3f3b7e33 --- /dev/null +++ b/perp/perpsysm.msgf @@ -0,0 +1,3 @@ +crtmsgf msgf($LIBRARY/$NAME) +addmsgd msgid(usr0001) msgf($LIBRARY/$NAME) msg('call wrkcmr') seclvl(*none) sev(00) fmt(*none) +addmsgd msgid(usr0002) msgf($LIBRARY/$NAME) msg('call wrkusrr') seclvl(*none) sev(00) fmt(*none) diff --git a/perp/perpvndm.msgf b/perp/perpvndm.msgf new file mode 100644 index 00000000..d17c0bc9 --- /dev/null +++ b/perp/perpvndm.msgf @@ -0,0 +1,4 @@ +crtmsgf msgf($LIBRARY/$NAME) +addmsgd msgid(usr0001) msgf($LIBRARY/$NAME) msg('call wrkvndr') seclvl(*none) sev(00) fmt(*none) +addmsgd msgid(usr0002) msgf($LIBRARY/$NAME) msg('call wrkivnr') seclvl(*none) sev(00) fmt(*none) +addmsgd msgid(usr0003) msgf($LIBRARY/$NAME) msg('call wrkivpr') seclvl(*none) sev(00) fmt(*none) diff --git a/perp/qclsrc/perpjrn.clle b/perp/qclsrc/perpjrn.clle new file mode 100644 index 00000000..4c7d19ab --- /dev/null +++ b/perp/qclsrc/perpjrn.clle @@ -0,0 +1,26 @@ +/* PERPJRN - Create the PERP journal + receiver in PERPDEMO. */ +/* Run once at library setup time. */ +/* PERPRCV001 - initial journal receiver */ +/* PERPJRN - the journal object */ + +PGM + + CRTJRNRCV JRNRCV(PERPDEMO/PERPRCV001) + + THRESHOLD(1000000) + + AUT(*USE) + + TEXT('PERP journal receiver (initial)') + MONMSG MSGID(CPF7010) + + CRTJRN JRN(PERPDEMO/PERPJRN) + + JRNRCV(PERPDEMO/PERPRCV001) + + MNGRCV(*SYSTEM) + + DLTRCV(*YES) + + RCVSIZOPT(*MAXOPT2 *RMVINTENT) + + JRNCACHE(*YES) + + AUT(*USE) + + TEXT('PERP journal - all PERP tables') + MONMSG MSGID(CPF7010) + + SNDPGMMSG MSG('PERPJRN + PERPRCV001 ready in PERPDEMO') + +ENDPGM diff --git a/perp/qclsrc/perpsjpf.clle b/perp/qclsrc/perpsjpf.clle new file mode 100644 index 00000000..b0690bb3 --- /dev/null +++ b/perp/qclsrc/perpsjpf.clle @@ -0,0 +1,15 @@ +/* PERPSJPF - Start journaling for a single PERP physical file. */ +/* Called after RUNSQLSTM creates a SQL table in PERPDEMO. */ +/* Parameter: &FILE - system name of the file, e.g. 'INVMSTR'. */ +/* Idempotent - silently ignores CPF7030 (already journaled). */ + +PGM PARM(&FILE) + DCL VAR(&FILE) TYPE(*CHAR) LEN(10) + + STRJRNPF FILE(PERPDEMO/&FILE) + + JRN(PERPDEMO/PERPJRN) + + IMAGES(*BOTH) + + OMTJRNE(*OPNCLO) + MONMSG MSGID(CPF7030) + +ENDPGM diff --git a/perp/qddlsrc/code_master.table.sql b/perp/qddlsrc/code_master.table.sql new file mode 100644 index 00000000..97cb58fb --- /dev/null +++ b/perp/qddlsrc/code_master.table.sql @@ -0,0 +1,52 @@ +-- --------------------------------------------------------------------------- +-- Table: code_master (system name CODEMSTR) +-- Module: perp +-- Purpose: Generic lookup table. Every enum/status/code/role in PERP +-- lives here keyed on (code_type, code_value). Business tables +-- reference it via a composite FK plus a constant-discriminator +-- column (DEFAULT + CHECK — see DDL_STYLE_GUIDE §10). +-- Epic: PERP-2 (Company & System Reference) +-- --------------------------------------------------------------------------- + +CREATE TABLE code_master FOR SYSTEM NAME CODEMSTR ( + + -- Composite natural key ------------------------------------------------- + code_type FOR COLUMN CODETYP VARCHAR(20) NOT NULL, + code_value FOR COLUMN CODEVAL VARCHAR(20) NOT NULL, + + -- Descriptive columns --------------------------------------------------- + description FOR COLUMN CODEDSC VARCHAR(60) NOT NULL, + short_desc FOR COLUMN SHTDSC VARCHAR(20) NOT NULL DEFAULT '', + sort_order FOR COLUMN SRTORD INTEGER NOT NULL DEFAULT 0, + + -- Free-form attributes (JSON-style extras). CLOB, not JSON, to keep the + -- table portable to older DB2 for i releases. + attributes FOR COLUMN ATTRS CLOB(4K) DEFAULT NULL, + + -- Standard audit block -------------------------------------------------- + created_at FOR COLUMN CRTAT TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP, + created_by FOR COLUMN CRTBY VARCHAR(18) NOT NULL DEFAULT USER, + updated_at FOR COLUMN UPDAT TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP, + updated_by FOR COLUMN UPDBY VARCHAR(18) NOT NULL DEFAULT USER, + is_active FOR COLUMN ISACT CHAR(1) NOT NULL DEFAULT 'Y', + + -- Composite primary key ------------------------------------------------- + PRIMARY KEY (code_type, code_value), + + -- Constraints ----------------------------------------------------------- + CONSTRAINT codemstr_srtord_ck CHECK (sort_order >= 0), + CONSTRAINT codemstr_isact_ck CHECK (is_active IN ('Y','N')) +); + +LABEL ON TABLE code_master IS + 'PERP generic lookup (statuses/roles/etc.)'; + +LABEL ON COLUMN code_master ( + code_type IS 'Code type / group (e.g. POSTATUS, USERROLE)', + code_value IS 'Code value within the type', + description IS 'Long description', + short_desc IS 'Short description (list / column display)', + sort_order IS 'Presentation sort order', + attributes IS 'Free-form JSON-style attributes (nullable)', + is_active IS 'Active flag (Y/N, soft delete)' +); diff --git a/perp/qddlsrc/company.table.sql b/perp/qddlsrc/company.table.sql new file mode 100644 index 00000000..f6b39347 --- /dev/null +++ b/perp/qddlsrc/company.table.sql @@ -0,0 +1,63 @@ +-- --------------------------------------------------------------------------- +-- Table: company (system name COMPANY) +-- Module: perp +-- Purpose: Multi-tenant root. Every business table in PERP FKs its +-- company_code column back to this table. +-- Epic: PERP-2 (Company & System Reference) +-- --------------------------------------------------------------------------- + +-- Note on FOR SYSTEM NAME here: 'company' as a SQL table name auto-derives +-- to the 10-char system name COMPANY. On DB2 for i, specifying FOR SYSTEM +-- NAME with a value equal to that auto-derivation raises SQL7029 - so we +-- omit it. Same rule applies to any FOR COLUMN whose value would equal the +-- column's auto-derived short name (see 'city_name' below - renamed from +-- 'city' so an explicit FOR COLUMN CITY is meaningful). +CREATE TABLE company ( + + -- Natural / multi-tenant key -------------------------------------------- + company_code FOR COLUMN COMPCD CHAR(3) NOT NULL, + + -- Descriptive columns --------------------------------------------------- + company_name FOR COLUMN COMPNM VARCHAR(60) NOT NULL, + address_line1 FOR COLUMN ADDR1 VARCHAR(60) NOT NULL DEFAULT '', + address_line2 FOR COLUMN ADDR2 VARCHAR(60) NOT NULL DEFAULT '', + city_name FOR COLUMN CITY VARCHAR(40) NOT NULL DEFAULT '', + state_code FOR COLUMN STATE VARCHAR(3) NOT NULL DEFAULT '', + postal_code FOR COLUMN POSTCD VARCHAR(12) NOT NULL DEFAULT '', + country_code FOR COLUMN CNTRY VARCHAR(3) NOT NULL DEFAULT 'US', + + -- Base currency (FK to code_master CURRENCY) --------------------------- + base_currency FOR COLUMN BASECUR VARCHAR(20) NOT NULL DEFAULT 'USD', + currency_type FOR COLUMN CURTYP VARCHAR(20) NOT NULL DEFAULT 'CURRENCY', + + -- Standard audit block -------------------------------------------------- + created_at FOR COLUMN CRTAT TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP, + created_by FOR COLUMN CRTBY VARCHAR(18) NOT NULL DEFAULT USER, + updated_at FOR COLUMN UPDAT TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP, + updated_by FOR COLUMN UPDBY VARCHAR(18) NOT NULL DEFAULT USER, + is_active FOR COLUMN ISACT CHAR(1) NOT NULL DEFAULT 'Y', + + -- Primary key ----------------------------------------------------------- + PRIMARY KEY (company_code), + + -- Constraints ----------------------------------------------------------- + CONSTRAINT company_isact_ck CHECK (is_active IN ('Y','N')), + CONSTRAINT company_curtyp_ck CHECK (currency_type = 'CURRENCY') +); + +LABEL ON TABLE company IS + 'PERP company / tenant root'; + +LABEL ON COLUMN company ( + company_code IS 'Company code (multi-tenant PK)', + company_name IS 'Company display name', + address_line1 IS 'Address line 1', + address_line2 IS 'Address line 2', + city_name IS 'City', + state_code IS 'State / province code', + postal_code IS 'Postal / ZIP code', + country_code IS 'ISO country code', + base_currency IS 'Base currency (FK to code_master CURRENCY)', + currency_type IS 'Currency type discriminator (constant)', + is_active IS 'Active flag (Y/N, soft delete)' +); diff --git a/perp/qddlsrc/company_config.table.sql b/perp/qddlsrc/company_config.table.sql new file mode 100644 index 00000000..b10de5a8 --- /dev/null +++ b/perp/qddlsrc/company_config.table.sql @@ -0,0 +1,47 @@ +-- --------------------------------------------------------------------------- +-- Table: company_config (system name COMPCFG) +-- Module: perp +-- Purpose: Per-company key/value config. Auto-approval thresholds and +-- other tunables live here rather than being hard-coded. +-- Epic: PERP-2 (Company & System Reference) +-- --------------------------------------------------------------------------- + +CREATE TABLE company_config FOR SYSTEM NAME COMPCFG ( + + -- Composite key --------------------------------------------------------- + company_code FOR COLUMN COMPCD CHAR(3) NOT NULL, + config_key FOR COLUMN CFGKEY VARCHAR(40) NOT NULL, + + -- Value + description --------------------------------------------------- + config_value FOR COLUMN CFGVAL VARCHAR(256) NOT NULL DEFAULT '', + description FOR COLUMN CFGDSC VARCHAR(60) NOT NULL DEFAULT '', + + -- Standard audit block -------------------------------------------------- + created_at FOR COLUMN CRTAT TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP, + created_by FOR COLUMN CRTBY VARCHAR(18) NOT NULL DEFAULT USER, + updated_at FOR COLUMN UPDAT TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP, + updated_by FOR COLUMN UPDBY VARCHAR(18) NOT NULL DEFAULT USER, + is_active FOR COLUMN ISACT CHAR(1) NOT NULL DEFAULT 'Y', + + -- Composite PK ---------------------------------------------------------- + PRIMARY KEY (company_code, config_key), + + -- Constraints ----------------------------------------------------------- + CONSTRAINT compcfg_isact_ck CHECK (is_active IN ('Y','N')), + + -- FK to company --------------------------------------------------------- + CONSTRAINT compcfg_company_fk FOREIGN KEY (company_code) + REFERENCES company (company_code) + ON DELETE RESTRICT ON UPDATE RESTRICT +); + +LABEL ON TABLE company_config IS + 'PERP per-company config key/value pairs'; + +LABEL ON COLUMN company_config ( + company_code IS 'Company code (FK to company)', + config_key IS 'Config key (dotted namespace, e.g. approval.auto_threshold)', + config_value IS 'Config value (string; caller parses)', + description IS 'Human-readable description of the key', + is_active IS 'Active flag (Y/N, soft delete)' +); diff --git a/perp/qddlsrc/document_sequence.table.sql b/perp/qddlsrc/document_sequence.table.sql new file mode 100644 index 00000000..136f89b2 --- /dev/null +++ b/perp/qddlsrc/document_sequence.table.sql @@ -0,0 +1,49 @@ +-- --------------------------------------------------------------------------- +-- Table: document_sequence (system name DOCSEQ) +-- Module: perp +-- Purpose: High-water mark per (company, document_type). Callers +-- atomically bump current_number to get the next doc number +-- for requisitions, POs, receipts. +-- Epic: PERP-2 (Company & System Reference) +-- --------------------------------------------------------------------------- + +CREATE TABLE document_sequence FOR SYSTEM NAME DOCSEQ ( + + -- Composite key --------------------------------------------------------- + company_code FOR COLUMN COMPCD CHAR(3) NOT NULL, + document_type FOR COLUMN DOCTYP VARCHAR(20) NOT NULL, + + -- Sequence state -------------------------------------------------------- + current_number FOR COLUMN CURNUM BIGINT NOT NULL DEFAULT 0, + description FOR COLUMN DOCDSC VARCHAR(60) NOT NULL DEFAULT '', + + -- Standard audit block -------------------------------------------------- + created_at FOR COLUMN CRTAT TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP, + created_by FOR COLUMN CRTBY VARCHAR(18) NOT NULL DEFAULT USER, + updated_at FOR COLUMN UPDAT TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP, + updated_by FOR COLUMN UPDBY VARCHAR(18) NOT NULL DEFAULT USER, + is_active FOR COLUMN ISACT CHAR(1) NOT NULL DEFAULT 'Y', + + -- Composite PK ---------------------------------------------------------- + PRIMARY KEY (company_code, document_type), + + -- Constraints ----------------------------------------------------------- + CONSTRAINT docseq_curnum_ck CHECK (current_number >= 0), + CONSTRAINT docseq_isact_ck CHECK (is_active IN ('Y','N')), + + -- FK to company --------------------------------------------------------- + CONSTRAINT docseq_company_fk FOREIGN KEY (company_code) + REFERENCES company (company_code) + ON DELETE RESTRICT ON UPDATE RESTRICT +); + +LABEL ON TABLE document_sequence IS + 'PERP per-company doc-number high-water marks'; + +LABEL ON COLUMN document_sequence ( + company_code IS 'Company code (FK to company)', + document_type IS 'Document type key (REQ, PO, RCP, ...)', + current_number IS 'Last-issued document number (bump before use)', + description IS 'Human-readable document-type label', + is_active IS 'Active flag (Y/N, soft delete)' +); diff --git a/perp/qddlsrc/example_reference.table.sql b/perp/qddlsrc/example_reference.table.sql new file mode 100644 index 00000000..57961eaa --- /dev/null +++ b/perp/qddlsrc/example_reference.table.sql @@ -0,0 +1,87 @@ +-- --------------------------------------------------------------------------- +-- Table: example_reference (system name EXMPREF) +-- Module: perp +-- Purpose: Reference implementation of every DDL convention in +-- perp/DDL_STYLE_GUIDE.md. Copy this file when creating a new +-- table so that no convention is accidentally dropped. +-- Epic: PERP-1 (Foundation) +-- +-- Notes on DB2 for i syntax: +-- * FOR COLUMN goes BETWEEN column name and data type. Placing it after +-- CHAR/VARCHAR raises SQL0199 because the parser treats "FOR ..." after +-- a character type as the CCSID modifier grammar. +-- * GENERATED ALWAYS AS ('literal') is rejected -- the generation +-- expression must reference a column of the same table. Use DEFAULT + +-- CHECK for the constant-discriminator pattern. +-- * CHECK constraints are declared as table-level CONSTRAINT clauses so +-- they have stable, human-readable names in DB2 catalog messages. +-- --------------------------------------------------------------------------- + +CREATE TABLE example_reference FOR SYSTEM NAME EXMPREF ( + + -- Multi-tenant key ------------------------------------------------------- + company_code FOR COLUMN COMPCD CHAR(3) NOT NULL, + + -- Natural key ------------------------------------------------------------ + ref_code FOR COLUMN REFCD VARCHAR(20) NOT NULL, + + -- Descriptive columns ---------------------------------------------------- + ref_name FOR COLUMN REFNM VARCHAR(60) NOT NULL, + ref_type FOR COLUMN REFTYP VARCHAR(20) NOT NULL, + + -- Numeric with CHECK (table-level constraint below) ---------------------- + sort_order FOR COLUMN SRTORD INTEGER NOT NULL DEFAULT 0, + + -- Effective dating example ---------------------------------------------- + effective_from FOR COLUMN EFFFRM DATE NOT NULL DEFAULT CURRENT_DATE, + effective_to FOR COLUMN EFFTO DATE, + + -- Constant discriminator + code FK (parent table lands in PERP-2) -------- + status_code FOR COLUMN STCODE VARCHAR(20) NOT NULL DEFAULT 'ACTIVE', + status_type FOR COLUMN STTYPE VARCHAR(20) NOT NULL DEFAULT 'EXMPSTAT', + + -- Standard audit block -------------------------------------------------- + created_at FOR COLUMN CRTAT TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP, + created_by FOR COLUMN CRTBY VARCHAR(18) NOT NULL DEFAULT USER, + updated_at FOR COLUMN UPDAT TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP, + updated_by FOR COLUMN UPDBY VARCHAR(18) NOT NULL DEFAULT USER, + is_active FOR COLUMN ISACT CHAR(1) NOT NULL DEFAULT 'Y', + + -- Composite PK — company_code leads -------------------------------------- + PRIMARY KEY (company_code, ref_code), + + -- Table-level CHECK constraints ----------------------------------------- + CONSTRAINT exmpref_srtord_ck CHECK (sort_order >= 0), + CONSTRAINT exmpref_isact_ck CHECK (is_active IN ('Y','N')), + CONSTRAINT exmpref_sttype_ck CHECK (status_type = 'EXMPSTAT'), + CONSTRAINT exmpref_efftv_ck CHECK (effective_to IS NULL + OR effective_to >= effective_from) + + -- Cross-table FKs would go here. For example, once code_master exists: + -- + -- , FOREIGN KEY (status_type, status_code) + -- REFERENCES code_master (code_type, code_value) + -- + -- and once company exists: + -- + -- , FOREIGN KEY (company_code) + -- REFERENCES company (company_code) + -- + -- They are commented out here because those parent tables land in PERP-2. +); + +LABEL ON TABLE example_reference IS + 'PERP DDL style-guide reference example table'; + +LABEL ON COLUMN example_reference ( + company_code IS 'Company code (multi-tenant key)', + ref_code IS 'Reference code (natural key)', + ref_name IS 'Reference name', + ref_type IS 'Reference type / category', + sort_order IS 'Presentation sort order', + effective_from IS 'Effective from date', + effective_to IS 'Effective to date (null = current)', + status_code IS 'Status (FK to code_master)', + status_type IS 'Status type discriminator (constant)', + is_active IS 'Active flag (Y/N, soft delete)' +); diff --git a/perp/qddlsrc/item.table.sql b/perp/qddlsrc/item.table.sql new file mode 100644 index 00000000..fa3e9619 --- /dev/null +++ b/perp/qddlsrc/item.table.sql @@ -0,0 +1,117 @@ +-- --------------------------------------------------------------------------- +-- Table: item (system name ITEM) +-- Module: perp +-- Purpose: Core item master. Balances (Option C), reorder parameters, +-- single location, UOM pair, and the lot_controlled flag that +-- drives item_lot behaviour. Items are not shared across +-- companies. +-- Epic: PERP-3 / PERP-20 (Inventory Master) +-- --------------------------------------------------------------------------- + +-- 'item' auto-derives to system name ITEM; specifying FOR SYSTEM NAME with +-- the same value raises SQL7029, so it's omitted (same rule as company.sql). +CREATE TABLE item ( + + -- Composite key (per-company) --------------------------------------------- + company_code FOR COLUMN COMPCD CHAR(3) NOT NULL, + item_number FOR COLUMN ITMNBR VARCHAR(25) NOT NULL, + + -- Descriptive columns ------------------------------------------------------- + item_description FOR COLUMN ITMDSC VARCHAR(60) NOT NULL, + short_description FOR COLUMN SHTDSC VARCHAR(20) NOT NULL DEFAULT '', + + -- Classification (FK to item_class) ------------------------------------ + class_code FOR COLUMN CLSCD VARCHAR(10) NOT NULL, + + -- UOMs (FK to uom) ---------------------------------------------------------- + inventory_uom FOR COLUMN INVUOM VARCHAR(5) NOT NULL, + stocking_uom FOR COLUMN STKUOM VARCHAR(5) NOT NULL, + + -- Lot control flag — drives item_lot behaviour ----------------------------- + lot_controlled FOR COLUMN LOTCTL CHAR(1) NOT NULL DEFAULT 'N', + + -- Balances — Option C: also denormalized onto item_lot for lot-controlled + -- items, so drift is possible by design (the reconciliation demo) -------- + qty_on_hand FOR COLUMN QTYOH DECIMAL(15,4) NOT NULL DEFAULT 0, + qty_available FOR COLUMN QTYAVL DECIMAL(15,4) NOT NULL DEFAULT 0, + qty_frozen FOR COLUMN QTYFRZ DECIMAL(15,4) NOT NULL DEFAULT 0, + qty_on_order FOR COLUMN QTYOO DECIMAL(15,4) NOT NULL DEFAULT 0, + + -- Reorder parameters ---------------------------------------------------- + reorder_point FOR COLUMN RORDPT DECIMAL(15,4) NOT NULL DEFAULT 0, + critical_level FOR COLUMN CRITLV DECIMAL(15,4) NOT NULL DEFAULT 0, + min_qty FOR COLUMN MINQTY DECIMAL(15,4) NOT NULL DEFAULT 0, + max_qty FOR COLUMN MAXQTY DECIMAL(15,4) NOT NULL DEFAULT 0, + safety_stock FOR COLUMN SAFSTK DECIMAL(15,4) NOT NULL DEFAULT 0, + lead_time_days FOR COLUMN LEADTM INTEGER NOT NULL DEFAULT 0, + + -- Single location (aisle/bay/shelf) -------------------------------------- + aisle_code FOR COLUMN AISLE VARCHAR(10) NOT NULL DEFAULT '', + bay_code FOR COLUMN BAY VARCHAR(10) NOT NULL DEFAULT '', + shelf_code FOR COLUMN SHELF VARCHAR(10) NOT NULL DEFAULT '', + + -- Standard audit block -------------------------------------------------- + created_at FOR COLUMN CRTAT TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP, + created_by FOR COLUMN CRTBY VARCHAR(18) NOT NULL DEFAULT USER, + updated_at FOR COLUMN UPDAT TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP, + updated_by FOR COLUMN UPDBY VARCHAR(18) NOT NULL DEFAULT USER, + is_active FOR COLUMN ISACT CHAR(1) NOT NULL DEFAULT 'Y', + + -- Composite primary key --------------------------------------------------- + PRIMARY KEY (company_code, item_number), + + -- Constraints --------------------------------------------------------------- + CONSTRAINT item_isact_ck CHECK (is_active IN ('Y','N')), + CONSTRAINT item_lotctl_ck CHECK (lot_controlled IN ('Y','N')), + CONSTRAINT item_qtyoh_ck CHECK (qty_on_hand >= 0), + CONSTRAINT item_qtyavl_ck CHECK (qty_available >= 0), + CONSTRAINT item_qtyfrz_ck CHECK (qty_frozen >= 0), + CONSTRAINT item_qtyoo_ck CHECK (qty_on_order >= 0), + CONSTRAINT item_rordpt_ck CHECK (reorder_point >= 0), + CONSTRAINT item_minqty_ck CHECK (min_qty >= 0), + CONSTRAINT item_maxqty_ck CHECK (max_qty >= min_qty), + CONSTRAINT item_safstk_ck CHECK (safety_stock >= 0), + CONSTRAINT item_leadtm_ck CHECK (lead_time_days >= 0), + + -- FKs ----------------------------------------------------------------------- + CONSTRAINT item_company_fk FOREIGN KEY (company_code) + REFERENCES company (company_code) + ON DELETE RESTRICT ON UPDATE RESTRICT, + CONSTRAINT item_class_fk FOREIGN KEY (company_code, class_code) + REFERENCES item_class (company_code, class_code) + ON DELETE RESTRICT ON UPDATE RESTRICT, + CONSTRAINT item_invuom_fk FOREIGN KEY (inventory_uom) + REFERENCES uom (uom_code) + ON DELETE RESTRICT ON UPDATE RESTRICT, + CONSTRAINT item_stkuom_fk FOREIGN KEY (stocking_uom) + REFERENCES uom (uom_code) + ON DELETE RESTRICT ON UPDATE RESTRICT +); + +LABEL ON TABLE item IS + 'PERP core item master'; + +LABEL ON COLUMN item ( + company_code IS 'Company code (FK to company)', + item_number IS 'Item number (natural key within company)', + item_description IS 'Item description', + short_description IS 'Short description (list / column display)', + class_code IS 'Item class (FK to item_class)', + inventory_uom IS 'Inventory UOM (FK to uom)', + stocking_uom IS 'Stocking UOM (FK to uom)', + lot_controlled IS 'Lot controlled flag (Y/N)', + qty_on_hand IS 'Quantity on hand', + qty_available IS 'Quantity available', + qty_frozen IS 'Quantity frozen', + qty_on_order IS 'Quantity on order', + reorder_point IS 'Reorder point', + critical_level IS 'Critical stock level', + min_qty IS 'Minimum quantity', + max_qty IS 'Maximum quantity', + safety_stock IS 'Safety stock quantity', + lead_time_days IS 'Lead time in days', + aisle_code IS 'Storage aisle', + bay_code IS 'Storage bay', + shelf_code IS 'Storage shelf', + is_active IS 'Active flag (Y/N, soft delete)' +); diff --git a/perp/qddlsrc/item_class.table.sql b/perp/qddlsrc/item_class.table.sql new file mode 100644 index 00000000..4f5caeb8 --- /dev/null +++ b/perp/qddlsrc/item_class.table.sql @@ -0,0 +1,53 @@ +-- --------------------------------------------------------------------------- +-- Table: item_class (system name ITMCLS) +-- Module: perp +-- Purpose: Flat item classification, per company. Items FK to this for +-- their class_code. +-- Epic: PERP-3 / PERP-20 (Inventory Master) +-- --------------------------------------------------------------------------- + +-- 'item_class' is itself a valid <=10-char system name (underscores +-- allowed), so any explicit FOR SYSTEM NAME here raises SQL7029 -- even a +-- value matching the true auto-derived name (ITEM_CLASS). The error message +-- echoes back whatever value *you* specified, not the real auto-derived +-- one -- confirmed here via DSPOBJD (object is PERPDEMO/ITEM_CLASS, not the +-- abbreviated ITMCLS this file originally guessed). Omit the clause and +-- verify the real object name with DSPOBJD/DSPFD rather than trusting the +-- SQL7029 message text. +CREATE TABLE item_class ( + + -- Composite key (per-company) --------------------------------------------- + company_code FOR COLUMN COMPCD CHAR(3) NOT NULL, + class_code FOR COLUMN CLSCD VARCHAR(10) NOT NULL, + + -- Descriptive columns ------------------------------------------------------- + description FOR COLUMN CLSDSC VARCHAR(60) NOT NULL, + + -- Standard audit block -------------------------------------------------- + created_at FOR COLUMN CRTAT TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP, + created_by FOR COLUMN CRTBY VARCHAR(18) NOT NULL DEFAULT USER, + updated_at FOR COLUMN UPDAT TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP, + updated_by FOR COLUMN UPDBY VARCHAR(18) NOT NULL DEFAULT USER, + is_active FOR COLUMN ISACT CHAR(1) NOT NULL DEFAULT 'Y', + + -- Composite primary key --------------------------------------------------- + PRIMARY KEY (company_code, class_code), + + -- Constraints --------------------------------------------------------------- + CONSTRAINT itmcls_isact_ck CHECK (is_active IN ('Y','N')), + + -- FK to company ------------------------------------------------------------- + CONSTRAINT itmcls_company_fk FOREIGN KEY (company_code) + REFERENCES company (company_code) + ON DELETE RESTRICT ON UPDATE RESTRICT +); + +LABEL ON TABLE item_class IS + 'PERP item classification (flat, per company)'; + +LABEL ON COLUMN item_class ( + company_code IS 'Company code (FK to company)', + class_code IS 'Item class code', + description IS 'Item class description', + is_active IS 'Active flag (Y/N, soft delete)' +); diff --git a/perp/qddlsrc/item_lot.table.sql b/perp/qddlsrc/item_lot.table.sql new file mode 100644 index 00000000..2bff68cf --- /dev/null +++ b/perp/qddlsrc/item_lot.table.sql @@ -0,0 +1,58 @@ +-- --------------------------------------------------------------------------- +-- Table: item_lot (system name ITMLOT) +-- Module: perp +-- Purpose: Lot balances for lot-controlled items (Option C — denormalized +-- alongside item.qty_on_hand so drift is possible by design; the +-- reconciliation demo (PERP-24) surfaces and resolves it). +-- Epic: PERP-3 / PERP-20 (Inventory Master) +-- --------------------------------------------------------------------------- + +-- 'item_lot' is itself a valid <=10-char system name; any explicit FOR +-- SYSTEM NAME here raises SQL7029 regardless of value. Real object name +-- (verified via DSPOBJD) is PERPDEMO/ITEM_LOT -- see the note in +-- item_class.table.sql for why the SQL7029 message text is misleading. +CREATE TABLE item_lot ( + + -- Composite key ----------------------------------------------------------- + company_code FOR COLUMN COMPCD CHAR(3) NOT NULL, + item_number FOR COLUMN ITMNBR VARCHAR(25) NOT NULL, + lot_number FOR COLUMN LOTNBR VARCHAR(20) NOT NULL, + + -- Lot balance and dates --------------------------------------------------- + qty_on_hand FOR COLUMN QTYOH DECIMAL(15,4) NOT NULL DEFAULT 0, + received_date FOR COLUMN RCVDT DATE NOT NULL DEFAULT CURRENT_DATE, + expiry_date FOR COLUMN EXPDT DATE, + + -- Standard audit block -------------------------------------------------- + created_at FOR COLUMN CRTAT TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP, + created_by FOR COLUMN CRTBY VARCHAR(18) NOT NULL DEFAULT USER, + updated_at FOR COLUMN UPDAT TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP, + updated_by FOR COLUMN UPDBY VARCHAR(18) NOT NULL DEFAULT USER, + is_active FOR COLUMN ISACT CHAR(1) NOT NULL DEFAULT 'Y', + + -- Composite primary key --------------------------------------------------- + PRIMARY KEY (company_code, item_number, lot_number), + + -- Constraints --------------------------------------------------------------- + CONSTRAINT itmlot_isact_ck CHECK (is_active IN ('Y','N')), + CONSTRAINT itmlot_qtyoh_ck CHECK (qty_on_hand >= 0), + CONSTRAINT itmlot_dt_ck CHECK (expiry_date IS NULL OR expiry_date >= received_date), + + -- FK to item ------------------------------------------------------------ + CONSTRAINT itmlot_item_fk FOREIGN KEY (company_code, item_number) + REFERENCES item (company_code, item_number) + ON DELETE RESTRICT ON UPDATE RESTRICT +); + +LABEL ON TABLE item_lot IS + 'PERP item lot balances (reconciliation demo)'; + +LABEL ON COLUMN item_lot ( + company_code IS 'Company code (FK to item)', + item_number IS 'Item number (FK to item)', + lot_number IS 'Lot number', + qty_on_hand IS 'Lot quantity on hand', + received_date IS 'Date lot was received', + expiry_date IS 'Lot expiry date (nullable)', + is_active IS 'Active flag (Y/N, soft delete)' +); diff --git a/perp/qddlsrc/item_uom_conversion.table.sql b/perp/qddlsrc/item_uom_conversion.table.sql new file mode 100644 index 00000000..f4a41277 --- /dev/null +++ b/perp/qddlsrc/item_uom_conversion.table.sql @@ -0,0 +1,58 @@ +-- --------------------------------------------------------------------------- +-- Table: item_uom_conversion (system name ITMUOMCV) +-- Module: perp +-- Purpose: Per-item UOM conversion factors (e.g. for item WIDGET1: +-- 1 CS = 12 EA). Looked up from the per-item conversion screen +-- reached from item maintenance (PERP-21). +-- Epic: PERP-3 / PERP-20 (Inventory Master) +-- --------------------------------------------------------------------------- + +CREATE TABLE item_uom_conversion FOR SYSTEM NAME ITMUOMCV ( + + -- Composite key ----------------------------------------------------------- + company_code FOR COLUMN COMPCD CHAR(3) NOT NULL, + item_number FOR COLUMN ITMNBR VARCHAR(25) NOT NULL, + from_uom FOR COLUMN FRMUOM VARCHAR(5) NOT NULL, + to_uom FOR COLUMN TOUOM VARCHAR(5) NOT NULL, + + -- Conversion factor: 1 from_uom = conversion_factor to_uom ----------------- + conversion_factor FOR COLUMN CONVFCT DECIMAL(15,6) NOT NULL, + + -- Standard audit block -------------------------------------------------- + created_at FOR COLUMN CRTAT TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP, + created_by FOR COLUMN CRTBY VARCHAR(18) NOT NULL DEFAULT USER, + updated_at FOR COLUMN UPDAT TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP, + updated_by FOR COLUMN UPDBY VARCHAR(18) NOT NULL DEFAULT USER, + is_active FOR COLUMN ISACT CHAR(1) NOT NULL DEFAULT 'Y', + + -- Composite primary key --------------------------------------------------- + PRIMARY KEY (company_code, item_number, from_uom, to_uom), + + -- Constraints --------------------------------------------------------------- + CONSTRAINT itmuomcv_isact_ck CHECK (is_active IN ('Y','N')), + CONSTRAINT itmuomcv_fct_ck CHECK (conversion_factor > 0), + CONSTRAINT itmuomcv_uom_ck CHECK (from_uom <> to_uom), + + -- FKs ----------------------------------------------------------------------- + CONSTRAINT itmuomcv_item_fk FOREIGN KEY (company_code, item_number) + REFERENCES item (company_code, item_number) + ON DELETE RESTRICT ON UPDATE RESTRICT, + CONSTRAINT itmuomcv_frmuom_fk FOREIGN KEY (from_uom) + REFERENCES uom (uom_code) + ON DELETE RESTRICT ON UPDATE RESTRICT, + CONSTRAINT itmuomcv_touom_fk FOREIGN KEY (to_uom) + REFERENCES uom (uom_code) + ON DELETE RESTRICT ON UPDATE RESTRICT +); + +LABEL ON TABLE item_uom_conversion IS + 'PERP per-item UOM conversion factors'; + +LABEL ON COLUMN item_uom_conversion ( + company_code IS 'Company code (FK to item)', + item_number IS 'Item number (FK to item)', + from_uom IS 'From UOM (FK to uom)', + to_uom IS 'To UOM (FK to uom)', + conversion_factor IS '1 from_uom = conversion_factor to_uom', + is_active IS 'Active flag (Y/N, soft delete)' +); diff --git a/perp/qddlsrc/item_vendor.table.sql b/perp/qddlsrc/item_vendor.table.sql new file mode 100644 index 00000000..3d4cf5ec --- /dev/null +++ b/perp/qddlsrc/item_vendor.table.sql @@ -0,0 +1,68 @@ +-- --------------------------------------------------------------------------- +-- Table: item_vendor (system name ITEM_VENDOR, auto-derived) +-- Module: perp +-- Purpose: Item <-> vendor sourcing profile. vendor_part_number, lead +-- time, MOQ, pack size, and the is_preferred flag that the +-- partial unique index below enforces (one preferred vendor +-- per item). See item_vendor_preferred_ak.index.sql. +-- Epic: PERP-5 (PERP-28) +-- --------------------------------------------------------------------------- + +-- 'item_vendor' (11 chars) exceeds the 10-char system-name cap, so DB2 +-- abbreviates unless we don't ask for a specific value -- omit FOR SYSTEM +-- NAME and confirm the real auto-derived name with DSPOBJD after build +-- (same approach as item_class/item_lot -- see DDL_STYLE_GUIDE.md Sec.2). +CREATE TABLE item_vendor ( + + -- Composite key ----------------------------------------------------------- + company_code FOR COLUMN COMPCD CHAR(3) NOT NULL, + item_number FOR COLUMN ITMNBR VARCHAR(25) NOT NULL, + vendor_code FOR COLUMN VNDCD VARCHAR(10) NOT NULL, + + -- Sourcing profile ---------------------------------------------------------- + vendor_part_number FOR COLUMN VPARTN VARCHAR(25) NOT NULL DEFAULT '', + lead_time_days FOR COLUMN LEADTM INTEGER NOT NULL DEFAULT 0, + moq DECIMAL(15,4) NOT NULL DEFAULT 0, + pack_size FOR COLUMN PACKSZ DECIMAL(15,4) NOT NULL DEFAULT 1, + is_preferred FOR COLUMN ISPREF CHAR(1) NOT NULL DEFAULT 'N', + + -- Standard audit block -------------------------------------------------- + created_at FOR COLUMN CRTAT TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP, + created_by FOR COLUMN CRTBY VARCHAR(18) NOT NULL DEFAULT USER, + updated_at FOR COLUMN UPDAT TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP, + updated_by FOR COLUMN UPDBY VARCHAR(18) NOT NULL DEFAULT USER, + is_active FOR COLUMN ISACT CHAR(1) NOT NULL DEFAULT 'Y', + + -- Composite primary key --------------------------------------------------- + PRIMARY KEY (company_code, item_number, vendor_code), + + -- Constraints ----------------------------------------------------------- + CONSTRAINT itmvnd_isact_ck CHECK (is_active IN ('Y','N')), + CONSTRAINT itmvnd_ispref_ck CHECK (is_preferred IN ('Y','N')), + CONSTRAINT itmvnd_leadtm_ck CHECK (lead_time_days >= 0), + CONSTRAINT itmvnd_moq_ck CHECK (moq >= 0), + CONSTRAINT itmvnd_packsz_ck CHECK (pack_size > 0), + + -- FKs ----------------------------------------------------------------------- + CONSTRAINT itmvnd_item_fk FOREIGN KEY (company_code, item_number) + REFERENCES item (company_code, item_number) + ON DELETE RESTRICT ON UPDATE RESTRICT, + CONSTRAINT itmvnd_vendor_fk FOREIGN KEY (company_code, vendor_code) + REFERENCES vendor (company_code, vendor_code) + ON DELETE RESTRICT ON UPDATE RESTRICT +); + +LABEL ON TABLE item_vendor IS + 'PERP item-vendor sourcing profile'; + +LABEL ON COLUMN item_vendor ( + company_code IS 'Company code (FK to item, vendor)', + item_number IS 'Item number (FK to item)', + vendor_code IS 'Vendor code (FK to vendor)', + vendor_part_number IS 'Vendor''s part number for this item', + lead_time_days IS 'Lead time in days', + moq IS 'Minimum order quantity', + pack_size IS 'Pack size (units per pack)', + is_preferred IS 'Preferred vendor flag (Y/N, one per item)', + is_active IS 'Active flag (Y/N, soft delete)' +); diff --git a/perp/qddlsrc/item_vendor_preferred_ak.index.sql b/perp/qddlsrc/item_vendor_preferred_ak.index.sql new file mode 100644 index 00000000..003cf933 --- /dev/null +++ b/perp/qddlsrc/item_vendor_preferred_ak.index.sql @@ -0,0 +1,12 @@ +-- --------------------------------------------------------------------------- +-- Index: item_vendor_preferred_ak +-- Module: perp +-- Purpose: Partial unique index enforcing at most one preferred vendor +-- (is_preferred = 'Y') per (company_code, item_number). Any +-- number of non-preferred rows are allowed. +-- Epic: PERP-5 (PERP-28) +-- --------------------------------------------------------------------------- + +CREATE UNIQUE INDEX item_vendor_preferred_ak + ON item_vendor (company_code, item_number) + WHERE is_preferred = 'Y'; diff --git a/perp/qddlsrc/item_vendor_price.table.sql b/perp/qddlsrc/item_vendor_price.table.sql new file mode 100644 index 00000000..459bac59 --- /dev/null +++ b/perp/qddlsrc/item_vendor_price.table.sql @@ -0,0 +1,75 @@ +-- --------------------------------------------------------------------------- +-- Table: item_vendor_price (system name abbreviated, >10 chars) +-- Module: perp +-- Purpose: Effective-dated pricing per item_vendor. Current row has +-- effective_to IS NULL. Historical rows are immutable -- a new +-- price closes the current row (sets effective_to) and inserts +-- a new row starting effective_from = today (see PERP-31). +-- Epic: PERP-5 (PERP-28) +-- --------------------------------------------------------------------------- + +-- 'item_vendor_price' (18 chars) exceeds the 10-char system-name cap; omit +-- FOR SYSTEM NAME and confirm the real auto-derived name with DSPOBJD +-- after build, per the SQL7029 guidance in DDL_STYLE_GUIDE.md Sec.2. +CREATE TABLE item_vendor_price ( + + -- Composite key (effective_from is part of the PK) ------------------------ + company_code FOR COLUMN COMPCD CHAR(3) NOT NULL, + item_number FOR COLUMN ITMNBR VARCHAR(25) NOT NULL, + vendor_code FOR COLUMN VNDCD VARCHAR(10) NOT NULL, + effective_from FOR COLUMN EFFFRM DATE NOT NULL DEFAULT CURRENT_DATE, + + -- Price --------------------------------------------------------------------- + effective_to FOR COLUMN EFFTO DATE, + unit_price FOR COLUMN UNTPRC DECIMAL(15,4) NOT NULL, + + -- Currency (constant discriminator + code_master FK) ---------------------- + currency_code FOR COLUMN CURR VARCHAR(20) NOT NULL DEFAULT 'USD', + currency_type FOR COLUMN CURTYP VARCHAR(20) NOT NULL DEFAULT 'CURRENCY', + + -- Where the price came from -------------------------------------------- + price_source FOR COLUMN PRCSRC VARCHAR(20) NOT NULL DEFAULT 'MANUAL', + + -- Standard audit block -------------------------------------------------- + created_at FOR COLUMN CRTAT TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP, + created_by FOR COLUMN CRTBY VARCHAR(18) NOT NULL DEFAULT USER, + updated_at FOR COLUMN UPDAT TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP, + updated_by FOR COLUMN UPDBY VARCHAR(18) NOT NULL DEFAULT USER, + is_active FOR COLUMN ISACT CHAR(1) NOT NULL DEFAULT 'Y', + + -- Composite primary key --------------------------------------------------- + PRIMARY KEY (company_code, item_number, vendor_code, effective_from), + + -- Constraints ----------------------------------------------------------- + CONSTRAINT itmvprc_isact_ck CHECK (is_active IN ('Y','N')), + CONSTRAINT itmvprc_curtyp_ck CHECK (currency_type = 'CURRENCY'), + CONSTRAINT itmvprc_prcsrc_ck CHECK (price_source IN ('MANUAL','IMPORT')), + CONSTRAINT itmvprc_price_ck CHECK (unit_price >= 0), + CONSTRAINT itmvprc_efftv_ck CHECK (effective_to IS NULL + OR effective_to >= effective_from), + + -- FKs (item + vendor referential integrity comes transitively through + -- item_vendor, which already FKs both) ----------------------------------- + CONSTRAINT itmvprc_itmvnd_fk FOREIGN KEY (company_code, item_number, vendor_code) + REFERENCES item_vendor (company_code, item_number, vendor_code) + ON DELETE RESTRICT ON UPDATE RESTRICT, + CONSTRAINT itmvprc_curr_fk FOREIGN KEY (currency_type, currency_code) + REFERENCES code_master (code_type, code_value) + ON DELETE RESTRICT ON UPDATE RESTRICT +); + +LABEL ON TABLE item_vendor_price IS + 'PERP effective-dated item-vendor pricing'; + +LABEL ON COLUMN item_vendor_price ( + company_code IS 'Company code (FK to item_vendor)', + item_number IS 'Item number (FK to item_vendor)', + vendor_code IS 'Vendor code (FK to item_vendor)', + effective_from IS 'Effective from date (PK)', + effective_to IS 'Effective to date (null = current)', + unit_price IS 'Unit price', + currency_code IS 'Currency (FK to code_master)', + currency_type IS 'Currency type discriminator (constant)', + price_source IS 'Price source (MANUAL/IMPORT)', + is_active IS 'Active flag (Y/N, soft delete)' +); diff --git a/perp/qddlsrc/item_vendor_price_history.view.sql b/perp/qddlsrc/item_vendor_price_history.view.sql new file mode 100644 index 00000000..a735decf --- /dev/null +++ b/perp/qddlsrc/item_vendor_price_history.view.sql @@ -0,0 +1,24 @@ +-- --------------------------------------------------------------------------- +-- View: item_vendor_price_history +-- Module: perp +-- Purpose: Effective-dated price history joined to vendor_name, for the +-- pricing-over-time graph demo. Data source for the itmvprcq +-- service program (PERP-32) and for any future UI that queries +-- it directly. Callers order by effective_from themselves -- +-- this view carries no ORDER BY (DB2 for i views don't guarantee +-- storage order without one, and ORDER BY on a view without +-- FETCH FIRST isn't portable). +-- Epic: PERP-5 (PERP-32) +-- --------------------------------------------------------------------------- + +CREATE VIEW item_vendor_price_history + (company_code, item_number, vendor_code, vendor_name, + effective_from, effective_to, unit_price, currency_code) AS + SELECT p.company_code, p.item_number, p.vendor_code, v.vendor_name, + p.effective_from, p.effective_to, p.unit_price, p.currency_code + FROM item_vendor_price p + JOIN vendor v + ON v.company_code = p.company_code AND v.vendor_code = p.vendor_code; + +LABEL ON TABLE item_vendor_price_history IS + 'PERP item-vendor price history (graph source)'; diff --git a/perp/qddlsrc/perp_user.table.sql b/perp/qddlsrc/perp_user.table.sql new file mode 100644 index 00000000..a0d27abb --- /dev/null +++ b/perp/qddlsrc/perp_user.table.sql @@ -0,0 +1,56 @@ +-- --------------------------------------------------------------------------- +-- Table: perp_user (system name PERPUSR) +-- Module: perp +-- Purpose: Application-level user directory. Typically maps 1:1 to an +-- IBM i user profile, but carries role + display attributes +-- used throughout PERP (buyer/receiver/approver/requester). +-- Epic: PERP-2 (Company & System Reference) +-- --------------------------------------------------------------------------- + +-- SQL name 'perp_user' is itself a valid ≤10-char system name (underscores +-- allowed), so DB2 for i rejects a different FOR SYSTEM NAME with SQL7029. +-- The system name auto-derives to PERP_USER; RPG references it that way. +CREATE TABLE perp_user ( + + -- Natural key ----------------------------------------------------------- + user_code FOR COLUMN USRCD CHAR(10) NOT NULL, + + -- Descriptive columns --------------------------------------------------- + display_name FOR COLUMN DSPNM VARCHAR(60) NOT NULL DEFAULT '', + email_address FOR COLUMN EMAIL VARCHAR(120) NOT NULL DEFAULT '', + + -- Role (FK to code_master USERROLE) ------------------------------------ + role_code FOR COLUMN ROLECD VARCHAR(20) NOT NULL DEFAULT 'REQUESTER', + role_type FOR COLUMN ROLETYP VARCHAR(20) NOT NULL DEFAULT 'USERROLE', + + -- Standard audit block -------------------------------------------------- + created_at FOR COLUMN CRTAT TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP, + created_by FOR COLUMN CRTBY VARCHAR(18) NOT NULL DEFAULT USER, + updated_at FOR COLUMN UPDAT TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP, + updated_by FOR COLUMN UPDBY VARCHAR(18) NOT NULL DEFAULT USER, + is_active FOR COLUMN ISACT CHAR(1) NOT NULL DEFAULT 'Y', + + -- Primary key ----------------------------------------------------------- + PRIMARY KEY (user_code), + + -- Constraints ----------------------------------------------------------- + CONSTRAINT perpusr_isact_ck CHECK (is_active IN ('Y','N')), + CONSTRAINT perpusr_roletyp_ck CHECK (role_type = 'USERROLE'), + + -- FK to code_master (USERROLE) ----------------------------------------- + CONSTRAINT perpusr_role_fk FOREIGN KEY (role_type, role_code) + REFERENCES code_master (code_type, code_value) + ON DELETE RESTRICT ON UPDATE RESTRICT +); + +LABEL ON TABLE perp_user IS + 'PERP application user directory'; + +LABEL ON COLUMN perp_user ( + user_code IS 'User code (typically IBM i user profile, PK)', + display_name IS 'Display name', + email_address IS 'Email address', + role_code IS 'Role (FK to code_master USERROLE)', + role_type IS 'Role type discriminator (constant)', + is_active IS 'Active flag (Y/N, soft delete)' +); diff --git a/perp/qddlsrc/po_header.table.sql b/perp/qddlsrc/po_header.table.sql new file mode 100644 index 00000000..169742d5 --- /dev/null +++ b/perp/qddlsrc/po_header.table.sql @@ -0,0 +1,102 @@ +-- --------------------------------------------------------------------------- +-- Table: po_header (system name PO_HEADER, auto-derived) +-- Module: perp +-- Purpose: Purchase order header. Buyer is snapshotted from vendor at +-- creation so historical POs keep their original buyer even if +-- the vendor is later reassigned. total_amount is maintained by +-- the PO entry program (UPDATE ... SET total_amount = SUM(...)) +-- — same idiom used by requisition_header.total_estimated_cost. +-- No po_display computed column here — DDL_STYLE_GUIDE.md Sec.9's +-- GENERATED ALWAYS AS (expression) pattern does not build on this +-- target (confirmed PERP-33); display formatting happens in RPG. +-- Epic: PERP-7 (PERP-37) +-- --------------------------------------------------------------------------- + +-- 'po_header' (9 chars) is itself a valid system name, so DB2 auto-derives +-- PO_HEADER and FOR SYSTEM NAME would raise SQL7029 — same rule as company +-- and vendor. Omit the clause and let it auto-derive. +CREATE TABLE po_header ( + + -- Composite key (per-company) --------------------------------------------- + company_code FOR COLUMN COMPCD CHAR(3) NOT NULL, + po_number FOR COLUMN PONBR BIGINT NOT NULL, + + -- Vendor / buyer ----------------------------------------------------------- + vendor_code FOR COLUMN VNDCD VARCHAR(10) NOT NULL, + -- buyer_code is snapshotted from vendor.buyer_code at PO creation. FK to + -- perp_user (same rule vendor.buyer_code follows) — a buyer must be a + -- real named user; CODERFLOW does not create POs (unlike requisition + -- approvals which can be system-stamped). + buyer_code FOR COLUMN BUYCD CHAR(10) NOT NULL, + + -- Dates ------------------------------------------------------------------- + order_date FOR COLUMN ORDDT DATE NOT NULL DEFAULT CURRENT_DATE, + + -- Status (FK to code_master POSTATUS) ------------------------------------- + status_code FOR COLUMN STCODE VARCHAR(20) NOT NULL DEFAULT 'DRAFT', + status_type FOR COLUMN STTYPE VARCHAR(20) NOT NULL DEFAULT 'POSTATUS', + + -- Currency (FK to code_master CURRENCY) ----------------------------------- + currency_code FOR COLUMN CURR VARCHAR(20) NOT NULL DEFAULT 'USD', + currency_type FOR COLUMN CURTYP VARCHAR(20) NOT NULL DEFAULT 'CURRENCY', + + -- Roll-up total. Maintained by po entry program on line insert/change/ + -- delete via the same UPDATE-with-subquery pattern requisition_header uses. + total_amount FOR COLUMN TOTAMT DECIMAL(15,2) NOT NULL DEFAULT 0, + + -- Long-form notes. 'notes' (5 chars) is itself a valid system name so + -- explicit FOR COLUMN NOTES raises SQL0612 — omit and let it auto-derive + -- (same finding as requisition_header, DDL_STYLE_GUIDE.md Sec.2). + notes CLOB(16K), + + -- Standard audit block ---------------------------------------------------- + created_at FOR COLUMN CRTAT TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP, + created_by FOR COLUMN CRTBY VARCHAR(18) NOT NULL DEFAULT USER, + updated_at FOR COLUMN UPDAT TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP, + updated_by FOR COLUMN UPDBY VARCHAR(18) NOT NULL DEFAULT USER, + is_active FOR COLUMN ISACT CHAR(1) NOT NULL DEFAULT 'Y', + + -- Composite primary key --------------------------------------------------- + PRIMARY KEY (company_code, po_number), + + -- Constraints ------------------------------------------------------------- + CONSTRAINT pohdr_isact_ck CHECK (is_active IN ('Y','N')), + CONSTRAINT pohdr_sttype_ck CHECK (status_type = 'POSTATUS'), + CONSTRAINT pohdr_curtyp_ck CHECK (currency_type = 'CURRENCY'), + CONSTRAINT pohdr_totamt_ck CHECK (total_amount >= 0), + + -- FKs ---------------------------------------------------------------------- + CONSTRAINT pohdr_company_fk FOREIGN KEY (company_code) + REFERENCES company (company_code) + ON DELETE RESTRICT ON UPDATE RESTRICT, + CONSTRAINT pohdr_vendor_fk FOREIGN KEY (company_code, vendor_code) + REFERENCES vendor (company_code, vendor_code) + ON DELETE RESTRICT ON UPDATE RESTRICT, + CONSTRAINT pohdr_buyer_fk FOREIGN KEY (buyer_code) + REFERENCES perp_user (user_code) + ON DELETE RESTRICT ON UPDATE RESTRICT, + CONSTRAINT pohdr_stat_fk FOREIGN KEY (status_type, status_code) + REFERENCES code_master (code_type, code_value) + ON DELETE RESTRICT ON UPDATE RESTRICT, + CONSTRAINT pohdr_curr_fk FOREIGN KEY (currency_type, currency_code) + REFERENCES code_master (code_type, code_value) + ON DELETE RESTRICT ON UPDATE RESTRICT +); + +LABEL ON TABLE po_header IS + 'PERP purchase order header'; + +LABEL ON COLUMN po_header ( + company_code IS 'Company code (FK to company)', + po_number IS 'PO number (doc_sequence PO)', + vendor_code IS 'Vendor (FK to vendor)', + buyer_code IS 'Buyer snapshot from vendor at creation', + order_date IS 'Date PO was placed', + status_code IS 'Status (FK to code_master POSTATUS)', + status_type IS 'Status type discriminator (constant)', + currency_code IS 'Currency (FK to code_master CURRENCY)', + currency_type IS 'Currency type discriminator (constant)', + total_amount IS 'Sum of line ordered_qty * unit_price', + notes IS 'Long-form notes', + is_active IS 'Active flag (Y/N, soft delete)' +); diff --git a/perp/qddlsrc/po_line.table.sql b/perp/qddlsrc/po_line.table.sql new file mode 100644 index 00000000..f00e3764 --- /dev/null +++ b/perp/qddlsrc/po_line.table.sql @@ -0,0 +1,120 @@ +-- --------------------------------------------------------------------------- +-- Table: po_line (system name PO_LINE, auto-derived) +-- Module: perp +-- Purpose: Purchase order line. unit_price is snapshotted from +-- item_vendor_price at PO creation so historical POs keep their +-- original price even if the current effective row is later +-- superseded (same snapshot idiom as buyer_code on po_header). +-- source_requisition_number / source_requisition_line_number +-- are nullable — populated only when the line originates from +-- a requisition (PERP-39). This line-level (not header-level) +-- linkage lets one requisition line be split across multiple +-- POs and multiple requisitions be consolidated into one PO. +-- open_qty is NOT a stored column — DDL_STYLE_GUIDE.md Sec.9's +-- GENERATED ALWAYS AS (expression) pattern does not build here. +-- Callers derive it as (ordered_qty - received_qty) in RPG or +-- via the po_line_open view (built in the same epic). +-- Epic: PERP-7 (PERP-37) +-- --------------------------------------------------------------------------- + +-- 'po_line' (7 chars) is itself a valid system name, so DB2 auto-derives +-- PO_LINE and FOR SYSTEM NAME would raise SQL7029. Omit the clause. +CREATE TABLE po_line ( + + -- Composite key (per-company, per-PO) ------------------------------------- + company_code FOR COLUMN COMPCD CHAR(3) NOT NULL, + po_number FOR COLUMN PONBR BIGINT NOT NULL, + line_number FOR COLUMN LINNBR INTEGER NOT NULL, + + -- Item / quantity --------------------------------------------------------- + item_number FOR COLUMN ITMNBR VARCHAR(25) NOT NULL, + ordered_qty FOR COLUMN ORDQTY DECIMAL(15,4) NOT NULL DEFAULT 0, + received_qty FOR COLUMN RCVQTY DECIMAL(15,4) NOT NULL DEFAULT 0, + uom_code FOR COLUMN UOMCD VARCHAR(5) NOT NULL, + + -- Snapshot at PO creation ------------------------------------------------- + unit_price FOR COLUMN UNTPRC DECIMAL(15,4) NOT NULL DEFAULT 0, + + -- Optional expected receipt date. Blanket-schedule lines with real + -- delivery dates live in po_line_schedule. + expected_receipt_date FOR COLUMN EXPRCV DATE, + + -- Line status (per-line, e.g. one line CLOSED while other lines OPEN). + -- Same POSTATUS lookup as the header. + status_code FOR COLUMN STCODE VARCHAR(20) NOT NULL DEFAULT 'OPEN', + status_type FOR COLUMN STTYPE VARCHAR(20) NOT NULL DEFAULT 'POSTATUS', + + -- Optional back-link to the requisition line this PO line came from. + -- Both are nullable together — a manual PO carries NULLs. The FK + -- constraint permits NULLs (RESTRICT on delete/update) — see reqln_ref_fk + -- at the bottom of the table. + source_requisition_number FOR COLUMN SRCRQN BIGINT, + source_requisition_line_number FOR COLUMN SRCRQL INTEGER, + + -- Standard audit block ---------------------------------------------------- + created_at FOR COLUMN CRTAT TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP, + created_by FOR COLUMN CRTBY VARCHAR(18) NOT NULL DEFAULT USER, + updated_at FOR COLUMN UPDAT TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP, + updated_by FOR COLUMN UPDBY VARCHAR(18) NOT NULL DEFAULT USER, + is_active FOR COLUMN ISACT CHAR(1) NOT NULL DEFAULT 'Y', + + -- Composite primary key --------------------------------------------------- + PRIMARY KEY (company_code, po_number, line_number), + + -- Constraints ------------------------------------------------------------- + CONSTRAINT poln_isact_ck CHECK (is_active IN ('Y','N')), + CONSTRAINT poln_linnbr_ck CHECK (line_number > 0), + CONSTRAINT poln_ordqty_ck CHECK (ordered_qty > 0), + CONSTRAINT poln_rcvqty_ck CHECK (received_qty >= 0 + AND received_qty <= ordered_qty), + CONSTRAINT poln_untprc_ck CHECK (unit_price >= 0), + CONSTRAINT poln_sttype_ck CHECK (status_type = 'POSTATUS'), + -- Requisition back-link is all-or-nothing. + CONSTRAINT poln_srcreq_ck CHECK ( + (source_requisition_number IS NULL AND source_requisition_line_number IS NULL) + OR + (source_requisition_number IS NOT NULL AND source_requisition_line_number IS NOT NULL) + ), + + -- FKs ---------------------------------------------------------------------- + CONSTRAINT poln_hdr_fk FOREIGN KEY (company_code, po_number) + REFERENCES po_header (company_code, po_number) + ON DELETE RESTRICT ON UPDATE RESTRICT, + CONSTRAINT poln_item_fk FOREIGN KEY (company_code, item_number) + REFERENCES item (company_code, item_number) + ON DELETE RESTRICT ON UPDATE RESTRICT, + CONSTRAINT poln_uom_fk FOREIGN KEY (uom_code) + REFERENCES uom (uom_code) + ON DELETE RESTRICT ON UPDATE RESTRICT, + CONSTRAINT poln_stat_fk FOREIGN KEY (status_type, status_code) + REFERENCES code_master (code_type, code_value) + ON DELETE RESTRICT ON UPDATE RESTRICT, + -- Composite FK to requisition_line — DB2 for i treats a composite FK + -- where any component is NULL as satisfied (MATCH SIMPLE default), so + -- manual PO lines with both source columns NULL pass without needing + -- a special "manual" placeholder row. + CONSTRAINT poln_srcreq_fk FOREIGN KEY + (company_code, source_requisition_number, source_requisition_line_number) + REFERENCES requisition_line (company_code, requisition_number, line_number) + ON DELETE RESTRICT ON UPDATE RESTRICT +); + +LABEL ON TABLE po_line IS + 'PERP purchase order line'; + +LABEL ON COLUMN po_line ( + company_code IS 'Company code (FK to po_header)', + po_number IS 'PO number (FK to po_header)', + line_number IS 'Line number within PO (PK)', + item_number IS 'Item number (FK to item)', + ordered_qty IS 'Quantity ordered', + received_qty IS 'Running receipt total (updated by receipts)', + uom_code IS 'Unit of measure (FK to uom)', + unit_price IS 'Unit price snapshot at PO creation', + expected_receipt_date IS 'Expected receipt date (null on blanket)', + status_code IS 'Line status (FK to code_master POSTATUS)', + status_type IS 'Status type discriminator (constant)', + source_requisition_number IS 'Source requisition number, null on manual PO', + source_requisition_line_number IS 'Source requisition line, null on manual PO', + is_active IS 'Active flag (Y/N, soft delete)' +); diff --git a/perp/qddlsrc/po_line_open.view.sql b/perp/qddlsrc/po_line_open.view.sql new file mode 100644 index 00000000..ec706286 --- /dev/null +++ b/perp/qddlsrc/po_line_open.view.sql @@ -0,0 +1,33 @@ +-- --------------------------------------------------------------------------- +-- View: po_line_open (system name PO_LINE_OP, auto-derived) +-- Module: perp +-- Purpose: Expose po_line with a computed open_qty column +-- (ordered_qty - received_qty). This is the workaround for the +-- "no GENERATED ALWAYS AS (expression) computed columns" gotcha +-- documented in DDL_STYLE_GUIDE.md Sec.9 — RPG reads either +-- po_line directly and derives open_qty in code, or joins this +-- view where open_qty is already computed. +-- Epic: PERP-7 (PERP-37) +-- --------------------------------------------------------------------------- + +CREATE VIEW po_line_open AS + SELECT company_code, + po_number, + line_number, + item_number, + ordered_qty, + received_qty, + (ordered_qty - received_qty) AS open_qty, + uom_code, + unit_price, + (ordered_qty * unit_price) AS extended_price, + expected_receipt_date, + status_code, + source_requisition_number, + source_requisition_line_number, + is_active + FROM po_line; + +-- LABEL ON TABLE caps at 50 chars on DB2 for i (DDL_STYLE_GUIDE.md Sec.2). +LABEL ON TABLE po_line_open IS + 'PERP po_line with open_qty + extended_price'; diff --git a/perp/qddlsrc/po_line_schedule.table.sql b/perp/qddlsrc/po_line_schedule.table.sql new file mode 100644 index 00000000..1a3933a5 --- /dev/null +++ b/perp/qddlsrc/po_line_schedule.table.sql @@ -0,0 +1,71 @@ +-- --------------------------------------------------------------------------- +-- Table: po_line_schedule (auto-derived short name) +-- Module: perp +-- Purpose: Blanket-PO delivery schedule. Optional per line — a normal PO +-- line has zero schedule rows and relies on +-- po_line.expected_receipt_date; a blanket line has one row per +-- scheduled delivery. scheduled_qty rolls up per line to the +-- same ordered_qty on po_line (soft warning if it doesn't; +-- see PERP-40 — the maintenance program flags but does not +-- block on the mismatch, since demo flows often adjust +-- ordered_qty after schedules are set). +-- Epic: PERP-7 (PERP-37) +-- --------------------------------------------------------------------------- + +-- 'po_line_schedule' is 16 chars — DB2 will auto-derive a short name +-- (same shape as requisition_header/line, confirmed via DSPOBJD after +-- build). FOR SYSTEM NAME omitted per DDL_STYLE_GUIDE.md Sec.2. +CREATE TABLE po_line_schedule ( + + -- Composite key (per-company, per-PO, per-line, per-schedule-seq) --------- + company_code FOR COLUMN COMPCD CHAR(3) NOT NULL, + po_number FOR COLUMN PONBR BIGINT NOT NULL, + line_number FOR COLUMN LINNBR INTEGER NOT NULL, + schedule_seq FOR COLUMN SCHSEQ INTEGER NOT NULL, + + -- Schedule -------------------------------------------------------------- + scheduled_date FOR COLUMN SCHDT DATE NOT NULL, + scheduled_qty FOR COLUMN SCHQTY DECIMAL(15,4) NOT NULL DEFAULT 0, + received_qty FOR COLUMN RCVQTY DECIMAL(15,4) NOT NULL DEFAULT 0, + + -- 'notes' auto-derives to a valid ≤10-char system name; explicit + -- FOR COLUMN NOTES raises SQL0612 (same finding as elsewhere) — omit. + notes VARCHAR(240) NOT NULL DEFAULT '', + + -- Standard audit block -------------------------------------------------- + created_at FOR COLUMN CRTAT TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP, + created_by FOR COLUMN CRTBY VARCHAR(18) NOT NULL DEFAULT USER, + updated_at FOR COLUMN UPDAT TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP, + updated_by FOR COLUMN UPDBY VARCHAR(18) NOT NULL DEFAULT USER, + is_active FOR COLUMN ISACT CHAR(1) NOT NULL DEFAULT 'Y', + + -- Composite primary key -------------------------------------------------- + PRIMARY KEY (company_code, po_number, line_number, schedule_seq), + + -- Constraints ----------------------------------------------------------- + CONSTRAINT posch_isact_ck CHECK (is_active IN ('Y','N')), + CONSTRAINT posch_seq_ck CHECK (schedule_seq > 0), + CONSTRAINT posch_schqty_ck CHECK (scheduled_qty > 0), + CONSTRAINT posch_rcvqty_ck CHECK (received_qty >= 0 + AND received_qty <= scheduled_qty), + + -- FK to po_line ----------------------------------------------------------- + CONSTRAINT posch_ln_fk FOREIGN KEY (company_code, po_number, line_number) + REFERENCES po_line (company_code, po_number, line_number) + ON DELETE RESTRICT ON UPDATE RESTRICT +); + +LABEL ON TABLE po_line_schedule IS + 'PERP PO blanket line delivery schedule'; + +LABEL ON COLUMN po_line_schedule ( + company_code IS 'Company code (FK to po_line)', + po_number IS 'PO number (FK to po_line)', + line_number IS 'Line number (FK to po_line)', + schedule_seq IS 'Schedule sequence within line (PK)', + scheduled_date IS 'Scheduled delivery date', + scheduled_qty IS 'Quantity scheduled for this delivery', + received_qty IS 'Quantity received against this schedule', + notes IS 'Schedule notes', + is_active IS 'Active flag (Y/N, soft delete)' +); diff --git a/perp/qddlsrc/po_receipt.table.sql b/perp/qddlsrc/po_receipt.table.sql new file mode 100644 index 00000000..ff35eb95 --- /dev/null +++ b/perp/qddlsrc/po_receipt.table.sql @@ -0,0 +1,89 @@ +-- --------------------------------------------------------------------------- +-- Table: po_receipt (system name PO_RECEIPT, auto-derived) +-- Module: perp +-- Purpose: Purchase order receipt header. One row per receiving event +-- against a PO (multiple receipts per PO are expected -- scheduled +-- / blanket deliveries and partial shipments both land here). +-- receipt_number is allocated from document_sequence via +-- docseq_next('RCP'), same idiom as po_number/requisition_number. +-- status_code defaults to POSTED -- unlike po_header/requisition +-- there is no DRAFT workflow here: creating a receipt line IS the +-- act of receiving (see rcventr, PERP-43), so the header is +-- POSTED from creation. RCPSTATUS (DRAFT/POSTED/VOIDED) was +-- already seeded in code_master by PERP-2/PERP-15; VOIDED exists +-- for a future void flow but no program sets it in this epic -- +-- same "lookup exists, no program uses it yet" deferral pattern +-- as POSTATUS.CANCELLED noted in PERP-7's recap. +-- Epic: PERP-8 (PERP-42) +-- --------------------------------------------------------------------------- + +-- 'po_receipt' (10 chars) is itself a valid system name, so DB2 auto-derives +-- PO_RECEIPT and an explicit FOR SYSTEM NAME would raise SQL7029 -- same +-- rule as po_line/po_header (DDL_STYLE_GUIDE.md Sec.2). +CREATE TABLE po_receipt ( + + -- Composite key (per-company) --------------------------------------------- + company_code FOR COLUMN COMPCD CHAR(3) NOT NULL, + receipt_number FOR COLUMN RCPNBR BIGINT NOT NULL, + + -- Source PO --------------------------------------------------------------- + po_number FOR COLUMN PONBR BIGINT NOT NULL, + + -- Receipt metadata ---------------------------------------------------------- + receipt_date FOR COLUMN RCPDT DATE NOT NULL DEFAULT CURRENT_DATE, + -- received_by is NOT FK'd to perp_user's role -- any perp_user may + -- receive; role-based restriction is out of scope for this epic. + received_by FOR COLUMN RCVBY CHAR(10) NOT NULL, + + -- Status (FK to code_master RCPSTATUS) ------------------------------------- + status_code FOR COLUMN STCODE VARCHAR(20) NOT NULL DEFAULT 'POSTED', + status_type FOR COLUMN STTYPE VARCHAR(20) NOT NULL DEFAULT 'RCPSTATUS', + + -- Long-form notes. 'notes' (5 chars) is itself a valid system name so + -- explicit FOR COLUMN NOTES raises SQL0612 -- omit and let it auto-derive + -- (same finding as po_header/requisition_header, DDL_STYLE_GUIDE.md Sec.2). + notes CLOB(16K), + + -- Standard audit block ---------------------------------------------------- + created_at FOR COLUMN CRTAT TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP, + created_by FOR COLUMN CRTBY VARCHAR(18) NOT NULL DEFAULT USER, + updated_at FOR COLUMN UPDAT TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP, + updated_by FOR COLUMN UPDBY VARCHAR(18) NOT NULL DEFAULT USER, + is_active FOR COLUMN ISACT CHAR(1) NOT NULL DEFAULT 'Y', + + -- Composite primary key --------------------------------------------------- + PRIMARY KEY (company_code, receipt_number), + + -- Constraints --------------------------------------------------------------- + CONSTRAINT porcp_isact_ck CHECK (is_active IN ('Y','N')), + CONSTRAINT porcp_sttype_ck CHECK (status_type = 'RCPSTATUS'), + + -- FKs ----------------------------------------------------------------------- + CONSTRAINT porcp_company_fk FOREIGN KEY (company_code) + REFERENCES company (company_code) + ON DELETE RESTRICT ON UPDATE RESTRICT, + CONSTRAINT porcp_po_fk FOREIGN KEY (company_code, po_number) + REFERENCES po_header (company_code, po_number) + ON DELETE RESTRICT ON UPDATE RESTRICT, + CONSTRAINT porcp_rcvby_fk FOREIGN KEY (received_by) + REFERENCES perp_user (user_code) + ON DELETE RESTRICT ON UPDATE RESTRICT, + CONSTRAINT porcp_stat_fk FOREIGN KEY (status_type, status_code) + REFERENCES code_master (code_type, code_value) + ON DELETE RESTRICT ON UPDATE RESTRICT +); + +LABEL ON TABLE po_receipt IS + 'PERP purchase order receipt header'; + +LABEL ON COLUMN po_receipt ( + company_code IS 'Company code (FK to po_header)', + receipt_number IS 'Receipt number (docseq RCP)', + po_number IS 'Source PO number (FK to po_header)', + receipt_date IS 'Date goods were received', + received_by IS 'Receiver (FK to perp_user)', + status_code IS 'Status (FK to code_master RCPSTATUS)', + status_type IS 'Status type discriminator (constant)', + notes IS 'Long-form notes', + is_active IS 'Active flag (Y/N, soft delete)' +); diff --git a/perp/qddlsrc/po_receipt_line.table.sql b/perp/qddlsrc/po_receipt_line.table.sql new file mode 100644 index 00000000..e745216d --- /dev/null +++ b/perp/qddlsrc/po_receipt_line.table.sql @@ -0,0 +1,106 @@ +-- --------------------------------------------------------------------------- +-- Table: po_receipt_line (auto-derived short name) +-- Module: perp +-- Purpose: Purchase order receipt line. Records what was actually received +-- against one po_line, in BOTH the vendor's UOM (as entered) and +-- the item's inventory UOM (as posted to item.qty_on_hand / +-- item_lot), plus the conversion factor snapshot used at receipt +-- time (same snapshot idiom as po_line.unit_price). +-- +-- po_number is denormalized from the parent po_receipt row. +-- po_receipt only carries po_number, not po_line's line_number, +-- so without this column a direct FK to po_line would need a +-- three-table join at insert time just to resolve one value. +-- Storing it here (like buyer_code on po_header, unit_price on +-- po_line) makes the FK to po_line direct and gives rcventr a +-- single INSERT instead of a lookup-then-insert. item_number is +-- denormalized from po_line the same way, for a direct FK to +-- item and so item_lot upserts don't need an extra join either. +-- +-- lot_number is nullable. The ticket's stated rule -- +-- "if item.lot_controlled = 'Y' then lot_number IS NOT NULL" -- +-- cannot be a DB2 for i CHECK constraint: a CHECK expression may +-- only reference columns of the table being defined, and +-- lot_controlled lives on item, a different table. Enforced in +-- rcventr (PERP-43) before INSERT instead; see +-- DDL_STYLE_GUIDE.md Sec.17 for the general rule. +-- Epic: PERP-8 (PERP-42) +-- --------------------------------------------------------------------------- + +-- 'po_receipt_line' is 16 chars -- DB2 will auto-derive a short name (same +-- shape as po_line_schedule/requisition_line). FOR SYSTEM NAME omitted per +-- DDL_STYLE_GUIDE.md Sec.2; confirm the real short name via DSPOBJD after +-- build before referencing it in any native/CL-level command. +CREATE TABLE po_receipt_line ( + + -- Composite key (per-company, per-receipt) --------------------------------- + company_code FOR COLUMN COMPCD CHAR(3) NOT NULL, + receipt_number FOR COLUMN RCPNBR BIGINT NOT NULL, + line_number FOR COLUMN LINNBR INTEGER NOT NULL, + + -- Denormalized back-link to po_line (see header note) ---------------------- + po_number FOR COLUMN PONBR BIGINT NOT NULL, + po_line_number FOR COLUMN POLNNBR INTEGER NOT NULL, + item_number FOR COLUMN ITMNBR VARCHAR(25) NOT NULL, + + -- Quantities: vendor UOM as entered, inventory UOM as posted, and the + -- conversion factor snapshot used to compute the latter from the former. + qty_received_vendor_uom FOR COLUMN QTYVUOM DECIMAL(15,4) NOT NULL, + qty_received_inventory_uom FOR COLUMN QTYIUOM DECIMAL(15,4) NOT NULL, + uom_conversion_factor FOR COLUMN CONVFCT DECIMAL(15,6) NOT NULL DEFAULT 1, + + -- Lot number -- required by rcventr when item.lot_controlled = 'Y', + -- nullable here since DB2 for i can't cross-table CHECK it (see header). + lot_number FOR COLUMN LOTNBR VARCHAR(20), + + -- 'notes' auto-derives to a valid <=10-char system name; explicit + -- FOR COLUMN NOTES raises SQL0612 (same finding as po_line_schedule) -- + -- omit. + notes VARCHAR(240) NOT NULL DEFAULT '', + + -- Standard audit block ---------------------------------------------------- + created_at FOR COLUMN CRTAT TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP, + created_by FOR COLUMN CRTBY VARCHAR(18) NOT NULL DEFAULT USER, + updated_at FOR COLUMN UPDAT TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP, + updated_by FOR COLUMN UPDBY VARCHAR(18) NOT NULL DEFAULT USER, + is_active FOR COLUMN ISACT CHAR(1) NOT NULL DEFAULT 'Y', + + -- Composite primary key --------------------------------------------------- + PRIMARY KEY (company_code, receipt_number, line_number), + + -- Constraints --------------------------------------------------------------- + CONSTRAINT porcl_isact_ck CHECK (is_active IN ('Y','N')), + CONSTRAINT porcl_linnbr_ck CHECK (line_number > 0), + CONSTRAINT porcl_qtyvuom_ck CHECK (qty_received_vendor_uom > 0), + CONSTRAINT porcl_qtyiuom_ck CHECK (qty_received_inventory_uom > 0), + CONSTRAINT porcl_convfct_ck CHECK (uom_conversion_factor > 0), + + -- FKs ----------------------------------------------------------------------- + CONSTRAINT porcl_rcpt_fk FOREIGN KEY (company_code, receipt_number) + REFERENCES po_receipt (company_code, receipt_number) + ON DELETE RESTRICT ON UPDATE RESTRICT, + CONSTRAINT porcl_poln_fk FOREIGN KEY (company_code, po_number, po_line_number) + REFERENCES po_line (company_code, po_number, line_number) + ON DELETE RESTRICT ON UPDATE RESTRICT, + CONSTRAINT porcl_item_fk FOREIGN KEY (company_code, item_number) + REFERENCES item (company_code, item_number) + ON DELETE RESTRICT ON UPDATE RESTRICT +); + +LABEL ON TABLE po_receipt_line IS + 'PERP purchase order receipt line'; + +LABEL ON COLUMN po_receipt_line ( + company_code IS 'Company code (FK to po_receipt)', + receipt_number IS 'Receipt number (FK to po_receipt)', + line_number IS 'Line number within receipt (PK)', + po_number IS 'Source PO number (FK to po_line, denorm)', + po_line_number IS 'Source PO line number (FK to po_line)', + item_number IS 'Item received (FK to item, denorm)', + qty_received_vendor_uom IS 'Qty received, vendor UOM (as entered)', + qty_received_inventory_uom IS 'Qty received, inventory UOM (as posted)', + uom_conversion_factor IS 'Vendor-to-inventory UOM factor snapshot', + lot_number IS 'Lot number, required if item lot-controlled', + notes IS 'Receipt line notes', + is_active IS 'Active flag (Y/N, soft delete)' +); diff --git a/perp/qddlsrc/reconciliation_log.table.sql b/perp/qddlsrc/reconciliation_log.table.sql new file mode 100644 index 00000000..24631ebe --- /dev/null +++ b/perp/qddlsrc/reconciliation_log.table.sql @@ -0,0 +1,86 @@ +-- --------------------------------------------------------------------------- +-- Table: reconciliation_log (auto-derived short name) +-- Module: perp +-- Purpose: Audit trail of lot-vs-item-balance drift detection and repair. +-- Written exclusively by the lotrecon service program (PERP-44) +-- -- no RPG program inserts into this table interactively. Has no +-- natural key (a reconciliation run doesn't identify itself by +-- anything but "when it happened"), so per DDL_STYLE_GUIDE.md +-- Sec.5 this is the one table in the module allowed a surrogate +-- GENERATED ALWAYS AS IDENTITY key. +-- +-- reconciled_by is NOT FK'd to perp_user -- an automated run +-- stamps the literal 'CODERFLOW', which is not a row in the human +-- user directory. Same rationale/pattern as +-- requisition_header.approved_by. +-- Epic: PERP-8 (PERP-42) +-- --------------------------------------------------------------------------- + +-- 'reconciliation_log' is 19 chars -- DB2 will auto-derive a short name. +-- FOR SYSTEM NAME omitted per DDL_STYLE_GUIDE.md Sec.2; confirm the real +-- short name via DSPOBJD after build. +CREATE TABLE reconciliation_log ( + + -- Composite key -- company_code leads per Sec.3, reconciliation_id is + -- the IDENTITY surrogate (globally unique on its own; company_code + -- still leads the PK for multi-tenant consistency with every other + -- table in the module). ------------------------------------------------ + company_code FOR COLUMN COMPCD CHAR(3) NOT NULL, + reconciliation_id FOR COLUMN RECONID INTEGER GENERATED ALWAYS AS IDENTITY + (START WITH 1 INCREMENT BY 1) NOT NULL, + + -- What was reconciled and when -------------------------------------------- + item_number FOR COLUMN ITMNBR VARCHAR(25) NOT NULL, + run_timestamp FOR COLUMN RUNTS TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP, + + -- Before / after balances -------------------------------------------------- + item_qty_before FOR COLUMN QTYBEF DECIMAL(15,4) NOT NULL, + lot_sum_before FOR COLUMN LOTBEF DECIMAL(15,4) NOT NULL, + qty_after FOR COLUMN QTYAFT DECIMAL(15,4) NOT NULL, + + -- Who/what ran the reconciliation. Not FK'd -- see header note. + reconciled_by FOR COLUMN RCNBY VARCHAR(18) NOT NULL, + + -- 'notes' auto-derives to a valid <=10-char system name; explicit + -- FOR COLUMN NOTES raises SQL0612 (same finding as elsewhere) -- omit. + notes VARCHAR(240) NOT NULL DEFAULT '', + + -- Standard audit block. This table is append-only in practice (no + -- program updates a row after insert), but every PERP table carries + -- the same five columns for module consistency. ----------------------- + created_at FOR COLUMN CRTAT TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP, + created_by FOR COLUMN CRTBY VARCHAR(18) NOT NULL DEFAULT USER, + updated_at FOR COLUMN UPDAT TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP, + updated_by FOR COLUMN UPDBY VARCHAR(18) NOT NULL DEFAULT USER, + is_active FOR COLUMN ISACT CHAR(1) NOT NULL DEFAULT 'Y', + + -- Composite primary key --------------------------------------------------- + PRIMARY KEY (company_code, reconciliation_id), + + -- Constraints --------------------------------------------------------------- + CONSTRAINT rcnlog_isact_ck CHECK (is_active IN ('Y','N')), + CONSTRAINT rcnlog_qtybef_ck CHECK (item_qty_before >= 0), + CONSTRAINT rcnlog_lotbef_ck CHECK (lot_sum_before >= 0), + CONSTRAINT rcnlog_qtyaft_ck CHECK (qty_after >= 0), + + -- FK to item ------------------------------------------------------------ + CONSTRAINT rcnlog_item_fk FOREIGN KEY (company_code, item_number) + REFERENCES item (company_code, item_number) + ON DELETE RESTRICT ON UPDATE RESTRICT +); + +LABEL ON TABLE reconciliation_log IS + 'PERP lot vs item balance reconciliation audit log'; + +LABEL ON COLUMN reconciliation_log ( + company_code IS 'Company code (FK to item)', + reconciliation_id IS 'Surrogate identity key (no natural key exists)', + item_number IS 'Item reconciled (FK to item)', + run_timestamp IS 'When the reconciliation ran', + item_qty_before IS 'item.qty_on_hand before repair', + lot_sum_before IS 'SUM(item_lot.qty_on_hand) before repair', + qty_after IS 'item.qty_on_hand after repair (= lot_sum_before)', + reconciled_by IS 'User code or CODERFLOW, not FK-enforced', + notes IS 'Reconciliation notes', + is_active IS 'Active flag (Y/N, soft delete)' +); diff --git a/perp/qddlsrc/requisition_header.table.sql b/perp/qddlsrc/requisition_header.table.sql new file mode 100644 index 00000000..b350bb80 --- /dev/null +++ b/perp/qddlsrc/requisition_header.table.sql @@ -0,0 +1,139 @@ +-- --------------------------------------------------------------------------- +-- Table: requisition_header (system name REQUI00001, auto-derived) +-- Module: perp +-- Purpose: Requisition header. Confidence score and full approval audit +-- (who/when/source/notes) are built in from day one so CoderFlow +-- auto-approval (PERP-36) has somewhere to write its verdict. +-- No back-pointer to PO here -- linkage lives on po_line (a later +-- epic) so one requisition line can be split/consolidated across +-- multiple POs. "Converted" status is derived by the PO epic +-- joining po_line back to this table's PK, not stored here. +-- Epic: PERP-6 (PERP-33) +-- --------------------------------------------------------------------------- + +-- 'requisition_header' (19 chars) exceeds the 10-char system-name cap, so +-- DB2 abbreviates unless we omit FOR SYSTEM NAME -- same approach as +-- item_vendor/item_vendor_price (DDL_STYLE_GUIDE.md Sec.2). Auto-derived to +-- REQUI00001 (sequential counter, confirmed via DSPOBJD after build -- +-- not a truncation of the SQL name, per the item_vendor_price precedent). +CREATE TABLE requisition_header ( + + -- Composite key (per-company) --------------------------------------------- + -- No requisition_display computed column here -- DDL_STYLE_GUIDE.md Sec.9's + -- GENERATED ALWAYS AS (expression) pattern does not build on this target + -- (confirmed PERP-33; see the style guide for the full finding). Any + -- display formatting happens in RPG/DSPF instead. + company_code FOR COLUMN COMPCD CHAR(3) NOT NULL, + requisition_number FOR COLUMN REQNBR BIGINT NOT NULL, + + -- Requester / dates --------------------------------------------------------- + requested_by FOR COLUMN REQBY CHAR(10) NOT NULL, + request_date FOR COLUMN REQDT DATE NOT NULL DEFAULT CURRENT_DATE, + need_by_date FOR COLUMN NEEDBY DATE NOT NULL, + + -- Priority (FK to code_master PRIORITY) ------------------------------------ + priority_code FOR COLUMN PRICD VARCHAR(20) NOT NULL DEFAULT 'NORMAL', + priority_type FOR COLUMN PRITYP VARCHAR(20) NOT NULL DEFAULT 'PRIORITY', + + -- Status (FK to code_master REQSTATUS) ------------------------------------- + status_code FOR COLUMN STCODE VARCHAR(20) NOT NULL DEFAULT 'DRAFT', + status_type FOR COLUMN STTYPE VARCHAR(20) NOT NULL DEFAULT 'REQSTATUS', + + -- Confidence -- NULL until CoderFlow scores it (PERP-36) ------------------- + confidence_pct FOR COLUMN CONFPCT DECIMAL(5,2), + + -- Approval audit -- all null until the requisition is approved/rejected. + -- approved_by is NOT FK'd to perp_user: an auto-approval stamps the + -- literal 'CODERFLOW', which is not a row in the human user directory. + approved_by FOR COLUMN APRBY VARCHAR(18), + approved_at FOR COLUMN APRAT TIMESTAMP, + approval_source_code FOR COLUMN APRSCD VARCHAR(20), + approval_source_type FOR COLUMN APRSTYP VARCHAR(20), + approval_notes FOR COLUMN APRNTS VARCHAR(500), + + -- Cost / currency ----------------------------------------------------------- + total_estimated_cost FOR COLUMN TOTEST DECIMAL(15,2) NOT NULL DEFAULT 0, + currency_code FOR COLUMN CURR VARCHAR(20) NOT NULL DEFAULT 'USD', + currency_type FOR COLUMN CURTYP VARCHAR(20) NOT NULL DEFAULT 'CURRENCY', + + -- Long-form justification. 'notes' (5 chars) is itself a valid system + -- name, so an explicit FOR COLUMN NOTES matching the auto-derivation + -- raises SQL0612 "duplicate column name" here (same root cause as the + -- SQL7029 case in DDL_STYLE_GUIDE.md Sec.2, different DB2 error) -- omit + -- the clause and let it auto-derive. ------------------------------------- + notes CLOB(16K), + + -- Standard audit block -------------------------------------------------- + created_at FOR COLUMN CRTAT TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP, + created_by FOR COLUMN CRTBY VARCHAR(18) NOT NULL DEFAULT USER, + updated_at FOR COLUMN UPDAT TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP, + updated_by FOR COLUMN UPDBY VARCHAR(18) NOT NULL DEFAULT USER, + is_active FOR COLUMN ISACT CHAR(1) NOT NULL DEFAULT 'Y', + + -- Composite primary key --------------------------------------------------- + PRIMARY KEY (company_code, requisition_number), + + -- Constraints ----------------------------------------------------------- + CONSTRAINT reqhdr_isact_ck CHECK (is_active IN ('Y','N')), + CONSTRAINT reqhdr_prityp_ck CHECK (priority_type = 'PRIORITY'), + CONSTRAINT reqhdr_sttype_ck CHECK (status_type = 'REQSTATUS'), + CONSTRAINT reqhdr_curtyp_ck CHECK (currency_type = 'CURRENCY'), + CONSTRAINT reqhdr_totest_ck CHECK (total_estimated_cost >= 0), + CONSTRAINT reqhdr_confpct_ck CHECK (confidence_pct IS NULL + OR (confidence_pct BETWEEN 0 AND 100)), + CONSTRAINT reqhdr_aprstyp_ck CHECK (approval_source_type IS NULL + OR approval_source_type = 'APPRSRC'), + -- Approval audit is all-or-nothing -- either nothing has happened yet, or + -- who/when/source were all stamped together by the same operation. + CONSTRAINT reqhdr_aprall_ck CHECK ( + (approved_by IS NULL AND approved_at IS NULL AND approval_source_code IS NULL) + OR + (approved_by IS NOT NULL AND approved_at IS NOT NULL AND approval_source_code IS NOT NULL) + ), + + -- FKs ----------------------------------------------------------------------- + CONSTRAINT reqhdr_company_fk FOREIGN KEY (company_code) + REFERENCES company (company_code) + ON DELETE RESTRICT ON UPDATE RESTRICT, + CONSTRAINT reqhdr_reqby_fk FOREIGN KEY (requested_by) + REFERENCES perp_user (user_code) + ON DELETE RESTRICT ON UPDATE RESTRICT, + CONSTRAINT reqhdr_pri_fk FOREIGN KEY (priority_type, priority_code) + REFERENCES code_master (code_type, code_value) + ON DELETE RESTRICT ON UPDATE RESTRICT, + CONSTRAINT reqhdr_stat_fk FOREIGN KEY (status_type, status_code) + REFERENCES code_master (code_type, code_value) + ON DELETE RESTRICT ON UPDATE RESTRICT, + CONSTRAINT reqhdr_apr_fk FOREIGN KEY (approval_source_type, approval_source_code) + REFERENCES code_master (code_type, code_value) + ON DELETE RESTRICT ON UPDATE RESTRICT, + CONSTRAINT reqhdr_curr_fk FOREIGN KEY (currency_type, currency_code) + REFERENCES code_master (code_type, code_value) + ON DELETE RESTRICT ON UPDATE RESTRICT +); + +LABEL ON TABLE requisition_header IS + 'PERP requisition header (confidence + approval)'; + +LABEL ON COLUMN requisition_header ( + company_code IS 'Company code (FK to company)', + requisition_number IS 'Requisition number (doc_sequence REQ)', + requested_by IS 'Requester (FK to perp_user)', + request_date IS 'Date requisition was created', + need_by_date IS 'Date requisition is needed by', + priority_code IS 'Priority (FK to code_master)', + priority_type IS 'Priority type discriminator (constant)', + status_code IS 'Status (FK to code_master)', + status_type IS 'Status type discriminator (constant)', + confidence_pct IS 'CoderFlow confidence pct, null until scored', + approved_by IS 'Approver user code or CODERFLOW, null until approved', + approved_at IS 'Approval/rejection timestamp', + approval_source_code IS 'Approval source (FK to code_master)', + approval_source_type IS 'Approval source type discriminator (constant)', + approval_notes IS 'Approval/rejection explanation', + total_estimated_cost IS 'Sum of line est_unit_cost * quantity', + currency_code IS 'Currency (FK to code_master)', + currency_type IS 'Currency type discriminator (constant)', + notes IS 'Long-form justification', + is_active IS 'Active flag (Y/N, soft delete)' +); diff --git a/perp/qddlsrc/requisition_line.table.sql b/perp/qddlsrc/requisition_line.table.sql new file mode 100644 index 00000000..94b8508e --- /dev/null +++ b/perp/qddlsrc/requisition_line.table.sql @@ -0,0 +1,82 @@ +-- --------------------------------------------------------------------------- +-- Table: requisition_line (system name REQUI00002, auto-derived) +-- Module: perp +-- Purpose: Requisition line. No status column here -- a line is +-- considered "converted" once a later epic's po_line FKs back to +-- it; that is derived by joining po_line to this table's PK, not +-- stored redundantly on the line itself. +-- Epic: PERP-6 (PERP-33) +-- --------------------------------------------------------------------------- + +-- 'requisition_line' (17 chars) exceeds the 10-char system-name cap, so DB2 +-- abbreviates unless we omit FOR SYSTEM NAME -- same approach as +-- requisition_header above. Auto-derived to REQUI00002 (confirmed via +-- DSPOBJD after build). +CREATE TABLE requisition_line ( + + -- Composite key (per-company, per-requisition) ----------------------------- + company_code FOR COLUMN COMPCD CHAR(3) NOT NULL, + requisition_number FOR COLUMN REQNBR BIGINT NOT NULL, + line_number FOR COLUMN LINNBR INTEGER NOT NULL, + + -- Item / quantity ----------------------------------------------------------- + item_number FOR COLUMN ITMNBR VARCHAR(25) NOT NULL, + quantity FOR COLUMN QTY DECIMAL(15,4) NOT NULL DEFAULT 0, + uom_code FOR COLUMN UOMCD VARCHAR(5) NOT NULL, + + -- Estimated cost (defaulted from the preferred vendor price on entry, + -- but editable -- see PERP-34) ---------------------------------------------- + est_unit_cost FOR COLUMN ESTCST DECIMAL(15,4) NOT NULL DEFAULT 0, + + -- Optional per-line override of the header's need_by_date; null means + -- "use the header date" -------------------------------------------------- + need_by_date FOR COLUMN NEEDBY DATE, + + -- 'notes' (5 chars) is itself a valid system name -- explicit FOR COLUMN + -- NOTES raises SQL0612 "duplicate column name" (see requisition_header + -- for the same finding); omit the clause and let it auto-derive. + notes VARCHAR(240) NOT NULL DEFAULT '', + + -- Standard audit block -------------------------------------------------- + created_at FOR COLUMN CRTAT TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP, + created_by FOR COLUMN CRTBY VARCHAR(18) NOT NULL DEFAULT USER, + updated_at FOR COLUMN UPDAT TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP, + updated_by FOR COLUMN UPDBY VARCHAR(18) NOT NULL DEFAULT USER, + is_active FOR COLUMN ISACT CHAR(1) NOT NULL DEFAULT 'Y', + + -- Composite primary key --------------------------------------------------- + PRIMARY KEY (company_code, requisition_number, line_number), + + -- Constraints ----------------------------------------------------------- + CONSTRAINT reqln_isact_ck CHECK (is_active IN ('Y','N')), + CONSTRAINT reqln_linnbr_ck CHECK (line_number > 0), + CONSTRAINT reqln_qty_ck CHECK (quantity > 0), + CONSTRAINT reqln_estcst_ck CHECK (est_unit_cost >= 0), + + -- FKs ----------------------------------------------------------------------- + CONSTRAINT reqln_hdr_fk FOREIGN KEY (company_code, requisition_number) + REFERENCES requisition_header (company_code, requisition_number) + ON DELETE RESTRICT ON UPDATE RESTRICT, + CONSTRAINT reqln_item_fk FOREIGN KEY (company_code, item_number) + REFERENCES item (company_code, item_number) + ON DELETE RESTRICT ON UPDATE RESTRICT, + CONSTRAINT reqln_uom_fk FOREIGN KEY (uom_code) + REFERENCES uom (uom_code) + ON DELETE RESTRICT ON UPDATE RESTRICT +); + +LABEL ON TABLE requisition_line IS + 'PERP requisition line'; + +LABEL ON COLUMN requisition_line ( + company_code IS 'Company code (FK to requisition_header)', + requisition_number IS 'Requisition number (FK to requisition_header)', + line_number IS 'Line number within requisition (PK)', + item_number IS 'Item number (FK to item)', + quantity IS 'Requested quantity', + uom_code IS 'Unit of measure (FK to uom)', + est_unit_cost IS 'Estimated unit cost', + need_by_date IS 'Line need-by override, null = use header date', + notes IS 'Line notes', + is_active IS 'Active flag (Y/N, soft delete)' +); diff --git a/perp/qddlsrc/seed/010_code_master.sql b/perp/qddlsrc/seed/010_code_master.sql new file mode 100644 index 00000000..9439e9c6 --- /dev/null +++ b/perp/qddlsrc/seed/010_code_master.sql @@ -0,0 +1,69 @@ +-- --------------------------------------------------------------------------- +-- Seed: 010_code_master +-- Module: perp +-- Purpose: Populate code_master with the system lookups that other epics +-- need to be able to reference. Idempotent — DELETE by +-- code_type first, then INSERT. Safe to re-run. +-- Epic: PERP-2 (PERP-15) +-- --------------------------------------------------------------------------- + +DELETE FROM code_master + WHERE code_type IN + ('REQSTATUS','POSTATUS','RCPSTATUS','CURRENCY', + 'PRIORITY','APPRSRC','USERROLE'); + +-- REQSTATUS — requisition status ------------------------------------------ +INSERT INTO code_master + (code_type, code_value, description, short_desc, sort_order) VALUES + ('REQSTATUS','DRAFT', 'Draft', 'Draft', 10), + ('REQSTATUS','SUBMITTED','Submitted', 'Submitted',20), + ('REQSTATUS','APPROVED', 'Approved', 'Approved', 30), + ('REQSTATUS','REJECTED', 'Rejected', 'Rejected', 40), + ('REQSTATUS','CONVERTED','Converted to PO','Converted',50), + ('REQSTATUS','CANCELLED','Cancelled', 'Cancelled',60); + +-- POSTATUS — purchase order status ---------------------------------------- +INSERT INTO code_master + (code_type, code_value, description, short_desc, sort_order) VALUES + ('POSTATUS','DRAFT', 'Draft', 'Draft', 10), + ('POSTATUS','OPEN', 'Open', 'Open', 20), + ('POSTATUS','PARTIAL', 'Partially received','Partial', 30), + ('POSTATUS','RECEIVED', 'Fully received', 'Received', 40), + ('POSTATUS','CLOSED', 'Closed', 'Closed', 50), + ('POSTATUS','CANCELLED','Cancelled', 'Cancelled',60); + +-- RCPSTATUS — receipt status ---------------------------------------------- +INSERT INTO code_master + (code_type, code_value, description, short_desc, sort_order) VALUES + ('RCPSTATUS','DRAFT', 'Draft', 'Draft', 10), + ('RCPSTATUS','POSTED','Posted', 'Posted',20), + ('RCPSTATUS','VOIDED','Voided', 'Voided',30); + +-- CURRENCY — currencies (single value for now) ---------------------------- +INSERT INTO code_master + (code_type, code_value, description, short_desc, sort_order) VALUES + ('CURRENCY','USD','US Dollar','USD',10); + +-- PRIORITY — request / order priority ------------------------------------- +INSERT INTO code_master + (code_type, code_value, description, short_desc, sort_order) VALUES + ('PRIORITY','LOW', 'Low', 'Low', 10), + ('PRIORITY','NORMAL', 'Normal', 'Normal', 20), + ('PRIORITY','HIGH', 'High', 'High', 30), + ('PRIORITY','CRITICAL','Critical', 'Critical',40); + +-- APPRSRC — approval source ----------------------------------------------- +INSERT INTO code_master + (code_type, code_value, description, short_desc, sort_order) VALUES + ('APPRSRC','HUMAN', 'Human approver', 'Human', 10), + ('APPRSRC','CODERFLOW', 'CoderFlow AI approver', 'AI', 20), + ('APPRSRC','AUTO_THRESHOLD','Auto-approved (threshold)','Auto', 30); + +-- USERROLE — application role -------------------------------------------- +INSERT INTO code_master + (code_type, code_value, description, short_desc, sort_order) VALUES + ('USERROLE','BUYER', 'Buyer', 'Buyer', 10), + ('USERROLE','RECEIVER', 'Receiver', 'Receiver',20), + ('USERROLE','APPROVER', 'Approver', 'Approver',30), + ('USERROLE','REQUESTER','Requester', 'Requester',40), + ('USERROLE','ADMIN', 'System administrator','Admin', 50); diff --git a/perp/qddlsrc/seed/020_payment_terms.sql b/perp/qddlsrc/seed/020_payment_terms.sql new file mode 100644 index 00000000..1b75d81b --- /dev/null +++ b/perp/qddlsrc/seed/020_payment_terms.sql @@ -0,0 +1,20 @@ +-- --------------------------------------------------------------------------- +-- Seed: 020_payment_terms +-- Module: perp +-- Purpose: Populate code_master with the PAYTERMS code_type that +-- vendor.payment_terms_code FKs to. Idempotent -- DELETE by +-- code_type first, then INSERT. Safe to re-run. +-- Epic: PERP-5 (PERP-28) +-- --------------------------------------------------------------------------- + +DELETE FROM code_master + WHERE code_type = 'PAYTERMS'; + +-- PAYTERMS — vendor payment terms ----------------------------------------- +INSERT INTO code_master + (code_type, code_value, description, short_desc, sort_order) VALUES + ('PAYTERMS','COD', 'Cash on delivery', 'COD', 10), + ('PAYTERMS','NET15', 'Net 15 days', 'Net 15', 20), + ('PAYTERMS','NET30', 'Net 30 days', 'Net 30', 30), + ('PAYTERMS','NET60', 'Net 60 days', 'Net 60', 40), + ('PAYTERMS','PREPAID','Prepaid', 'Prepaid',50); diff --git a/perp/qddlsrc/seed/025_approval_thresholds.sql b/perp/qddlsrc/seed/025_approval_thresholds.sql new file mode 100644 index 00000000..23cf7fc0 --- /dev/null +++ b/perp/qddlsrc/seed/025_approval_thresholds.sql @@ -0,0 +1,28 @@ +-- --------------------------------------------------------------------------- +-- Seed: 025_approval_thresholds +-- Module: perp +-- Purpose: Populate company_config with the auto-approval thresholds +-- reqauto (PERP-36) reads: a minimum confidence_pct and a maximum +-- total_estimated_cost. Both must pass for auto-approval. +-- Idempotent -- DELETE by config_key first, then INSERT. +-- +-- Numbered 025 (not 030) to leave 030 free for PERP-9's planned +-- 030_items.sql (see the ACME Seed Dataset Spec Confluence page, +-- 2512060417) -- these two seed scripts were written independently +-- and would otherwise collide. Key names here +-- (approval.auto_threshold / approval.auto_max_amount) also differ +-- from that page's originally-planned auto_approve_threshold_pct / +-- auto_approve_max_amount; reconciled on the spec page rather than +-- silently diverging -- see that page for the full note. +-- Epic: PERP-6 (PERP-36) +-- --------------------------------------------------------------------------- + +DELETE FROM company_config + WHERE config_key IN ('approval.auto_threshold', 'approval.auto_max_amount'); + +INSERT INTO company_config + (company_code, config_key, config_value, description) VALUES + ('ACM', 'approval.auto_threshold', '85', 'Min confidence_pct for CoderFlow auto-approval'), + ('ACM', 'approval.auto_max_amount', '500.00', 'Max total_estimated_cost for CoderFlow auto-approval'), + ('BET', 'approval.auto_threshold', '85', 'Min confidence_pct for CoderFlow auto-approval'), + ('BET', 'approval.auto_max_amount', '500.00', 'Max total_estimated_cost for CoderFlow auto-approval'); diff --git a/perp/qddlsrc/uom.table.sql b/perp/qddlsrc/uom.table.sql new file mode 100644 index 00000000..25d9b8de --- /dev/null +++ b/perp/qddlsrc/uom.table.sql @@ -0,0 +1,46 @@ +-- --------------------------------------------------------------------------- +-- Table: uom (system name UOM) +-- Module: perp +-- Purpose: Unit-of-measure master. Global (not company-scoped) — items in +-- every company reference the same UOM codes. Kept as its own +-- table rather than a code_master row because UOMs carry +-- structural attributes (see item_uom_conversion) that don't fit +-- the generic lookup shape. +-- Epic: PERP-3 / PERP-20 (Inventory Master) +-- --------------------------------------------------------------------------- + +-- 'uom' auto-derives to system name UOM; specifying FOR SYSTEM NAME with +-- the same value raises SQL7029, so it's omitted here (see company.table.sql +-- for the same rule applied to 'company'). +CREATE TABLE uom ( + + -- Natural key ------------------------------------------------------------- + uom_code FOR COLUMN UOMCD VARCHAR(5) NOT NULL, + + -- Descriptive columns ------------------------------------------------------- + description FOR COLUMN UOMDSC VARCHAR(60) NOT NULL, + uom_category FOR COLUMN UOMCAT VARCHAR(20) NOT NULL DEFAULT '', + + -- Standard audit block -------------------------------------------------- + created_at FOR COLUMN CRTAT TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP, + created_by FOR COLUMN CRTBY VARCHAR(18) NOT NULL DEFAULT USER, + updated_at FOR COLUMN UPDAT TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP, + updated_by FOR COLUMN UPDBY VARCHAR(18) NOT NULL DEFAULT USER, + is_active FOR COLUMN ISACT CHAR(1) NOT NULL DEFAULT 'Y', + + -- Primary key ------------------------------------------------------------- + PRIMARY KEY (uom_code), + + -- Constraints ------------------------------------------------------------- + CONSTRAINT uom_isact_ck CHECK (is_active IN ('Y','N')) +); + +LABEL ON TABLE uom IS + 'PERP unit-of-measure master'; + +LABEL ON COLUMN uom ( + uom_code IS 'Unit of measure code (PK)', + description IS 'UOM description', + uom_category IS 'UOM category (e.g. WEIGHT, VOLUME, EACH)', + is_active IS 'Active flag (Y/N, soft delete)' +); diff --git a/perp/qddlsrc/vendor.table.sql b/perp/qddlsrc/vendor.table.sql new file mode 100644 index 00000000..02459304 --- /dev/null +++ b/perp/qddlsrc/vendor.table.sql @@ -0,0 +1,92 @@ +-- --------------------------------------------------------------------------- +-- Table: vendor (system name VENDOR) +-- Module: perp +-- Purpose: Vendor master. Buyer assignment (FK to perp_user) is later +-- snapshotted onto po_header at PO creation time -- see the +-- "buyer snapshot pattern" on the Design Decisions & Conventions +-- page. Payment terms is a code_master (PAYTERMS) lookup. +-- Epic: PERP-5 (PERP-28) +-- --------------------------------------------------------------------------- + +-- 'vendor' auto-derives to system name VENDOR; specifying FOR SYSTEM NAME +-- with the same value raises SQL7029 (same rule as company/item), so it's +-- omitted here. +CREATE TABLE vendor ( + + -- Composite key (per-company) --------------------------------------------- + company_code FOR COLUMN COMPCD CHAR(3) NOT NULL, + vendor_code FOR COLUMN VNDCD VARCHAR(10) NOT NULL, + + -- Descriptive columns ----------------------------------------------------- + vendor_name FOR COLUMN VNDNM VARCHAR(60) NOT NULL, + + -- Address block (same shape as company.table.sql) -------------------------- + address_line1 FOR COLUMN ADDR1 VARCHAR(60) NOT NULL DEFAULT '', + address_line2 FOR COLUMN ADDR2 VARCHAR(60) NOT NULL DEFAULT '', + city_name FOR COLUMN CITY VARCHAR(40) NOT NULL DEFAULT '', + state_code FOR COLUMN STATE VARCHAR(3) NOT NULL DEFAULT '', + postal_code FOR COLUMN POSTCD VARCHAR(12) NOT NULL DEFAULT '', + country_code FOR COLUMN CNTRY VARCHAR(3) NOT NULL DEFAULT 'US', + + -- Contact info -------------------------------------------------------------- + phone_number FOR COLUMN PHONE VARCHAR(20) NOT NULL DEFAULT '', + email_address FOR COLUMN EMAIL VARCHAR(120) NOT NULL DEFAULT '', + contact_name FOR COLUMN CNTCNM VARCHAR(60) NOT NULL DEFAULT '', + + -- Buyer assignment (FK to perp_user) --------------------------------------- + buyer_code FOR COLUMN BUYCD CHAR(10) NOT NULL, + + -- Payment terms (constant discriminator + code_master FK) ----------------- + payment_terms_code FOR COLUMN PTCODE VARCHAR(20) NOT NULL DEFAULT 'NET30', + payment_terms_type FOR COLUMN PTTYPE VARCHAR(20) NOT NULL DEFAULT 'PAYTERMS', + + tax_id FOR COLUMN TAXID VARCHAR(20) NOT NULL DEFAULT '', + + -- Standard audit block -------------------------------------------------- + created_at FOR COLUMN CRTAT TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP, + created_by FOR COLUMN CRTBY VARCHAR(18) NOT NULL DEFAULT USER, + updated_at FOR COLUMN UPDAT TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP, + updated_by FOR COLUMN UPDBY VARCHAR(18) NOT NULL DEFAULT USER, + is_active FOR COLUMN ISACT CHAR(1) NOT NULL DEFAULT 'Y', + + -- Composite primary key --------------------------------------------------- + PRIMARY KEY (company_code, vendor_code), + + -- Constraints ----------------------------------------------------------- + CONSTRAINT vendor_isact_ck CHECK (is_active IN ('Y','N')), + CONSTRAINT vendor_pttyp_ck CHECK (payment_terms_type = 'PAYTERMS'), + + -- FKs ----------------------------------------------------------------------- + CONSTRAINT vendor_company_fk FOREIGN KEY (company_code) + REFERENCES company (company_code) + ON DELETE RESTRICT ON UPDATE RESTRICT, + CONSTRAINT vendor_buyer_fk FOREIGN KEY (buyer_code) + REFERENCES perp_user (user_code) + ON DELETE RESTRICT ON UPDATE RESTRICT, + CONSTRAINT vendor_ptcode_fk FOREIGN KEY (payment_terms_type, payment_terms_code) + REFERENCES code_master (code_type, code_value) + ON DELETE RESTRICT ON UPDATE RESTRICT +); + +LABEL ON TABLE vendor IS + 'PERP vendor master'; + +LABEL ON COLUMN vendor ( + company_code IS 'Company code (FK to company)', + vendor_code IS 'Vendor code (natural key within company)', + vendor_name IS 'Vendor name', + address_line1 IS 'Address line 1', + address_line2 IS 'Address line 2', + city_name IS 'City', + state_code IS 'State / province code', + postal_code IS 'Postal / ZIP code', + country_code IS 'ISO country code', + phone_number IS 'Phone number', + email_address IS 'Email address', + contact_name IS 'Contact person name', + buyer_code IS 'Buyer (FK to perp_user)', + payment_terms_code IS 'Payment terms (FK to code_master)', + payment_terms_type IS 'Payment terms type discriminator (constant)', + tax_id IS 'Tax ID', + is_active IS 'Active flag (Y/N, soft delete)' +); diff --git a/perp/qddlsrc/warehouse_layout.table.sql b/perp/qddlsrc/warehouse_layout.table.sql new file mode 100644 index 00000000..beffc4ee --- /dev/null +++ b/perp/qddlsrc/warehouse_layout.table.sql @@ -0,0 +1,79 @@ +-- --------------------------------------------------------------------------- +-- Table: warehouse_layout (system name WLAYOUT) +-- Module: perp +-- Purpose: Per-company warehouse grid config -- aisle x bay x shelf counts +-- and bin/aisle dimensions in meters. One row per company; drives +-- the coordinate derivation in the whcoord service (PERP-27). +-- Epic: PERP-4 (3D Warehouse Map) / PERP-25 +-- +-- Notes on DB2 for i syntax: +-- * 'notes' is <=10 chars and pure alphanumeric, so it already auto- +-- derives to system name NOTES -- an explicit FOR COLUMN NOTES would +-- raise SQL7029 (same rule as 'item'/'uom'/'company'; see +-- DDL_STYLE_GUIDE.md sec 2). Omitted here for that reason. +-- --------------------------------------------------------------------------- + +CREATE TABLE warehouse_layout FOR SYSTEM NAME WLAYOUT ( + + -- Primary key (one row per company) -------------------------------------- + company_code FOR COLUMN COMPCD CHAR(3) NOT NULL, + + -- Descriptive --------------------------------------------------------------- + warehouse_name FOR COLUMN WHSNM VARCHAR(60) NOT NULL DEFAULT '', + + -- Grid dimensions --------------------------------------------------------- + aisle_count FOR COLUMN ASLCNT INTEGER NOT NULL DEFAULT 1, + bays_per_aisle FOR COLUMN BAYSPA INTEGER NOT NULL DEFAULT 1, + shelves_per_bay FOR COLUMN SHLFSB INTEGER NOT NULL DEFAULT 1, + + -- Bin dimensions, in meters ------------------------------------------------- + bin_width_m FOR COLUMN BINWID DECIMAL(9,4) NOT NULL DEFAULT 1, + bin_depth_m FOR COLUMN BINDEP DECIMAL(9,4) NOT NULL DEFAULT 1, + bin_height_m FOR COLUMN BINHGT DECIMAL(9,4) NOT NULL DEFAULT 1, + aisle_spacing_m FOR COLUMN ASLSPC DECIMAL(9,4) NOT NULL DEFAULT 2, + + -- Free-text notes -- system name auto-derives, see header note ------------ + notes VARCHAR(60) NOT NULL DEFAULT '', + + -- Standard audit block -------------------------------------------------- + created_at FOR COLUMN CRTAT TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP, + created_by FOR COLUMN CRTBY VARCHAR(18) NOT NULL DEFAULT USER, + updated_at FOR COLUMN UPDAT TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP, + updated_by FOR COLUMN UPDBY VARCHAR(18) NOT NULL DEFAULT USER, + is_active FOR COLUMN ISACT CHAR(1) NOT NULL DEFAULT 'Y', + + -- Primary key ------------------------------------------------------------- + PRIMARY KEY (company_code), + + -- Constraints ------------------------------------------------------------- + CONSTRAINT wlayout_aslcnt_ck CHECK (aisle_count >= 1), + CONSTRAINT wlayout_bayspa_ck CHECK (bays_per_aisle >= 1), + CONSTRAINT wlayout_shlfsb_ck CHECK (shelves_per_bay >= 1), + CONSTRAINT wlayout_binwid_ck CHECK (bin_width_m > 0), + CONSTRAINT wlayout_bindep_ck CHECK (bin_depth_m > 0), + CONSTRAINT wlayout_binhgt_ck CHECK (bin_height_m > 0), + CONSTRAINT wlayout_aslspc_ck CHECK (aisle_spacing_m >= 0), + CONSTRAINT wlayout_isact_ck CHECK (is_active IN ('Y','N')), + + -- FK ------------------------------------------------------------------------ + CONSTRAINT wlayout_company_fk FOREIGN KEY (company_code) + REFERENCES company (company_code) + ON DELETE RESTRICT ON UPDATE RESTRICT +); + +LABEL ON TABLE warehouse_layout IS + 'Warehouse layout config (one row per company)'; + +LABEL ON COLUMN warehouse_layout ( + company_code IS 'Company code (PK, FK to company)', + warehouse_name IS 'Warehouse name', + aisle_count IS 'Number of aisles in the grid', + bays_per_aisle IS 'Bays per aisle', + shelves_per_bay IS 'Shelves per bay', + bin_width_m IS 'Bin width in meters (x axis)', + bin_depth_m IS 'Bin depth in meters', + bin_height_m IS 'Bin height in meters (z axis)', + aisle_spacing_m IS 'Spacing between aisles in meters (y axis)', + notes IS 'Free-text notes', + is_active IS 'Active flag (Y/N, soft delete)' +); diff --git a/perp/qddssrc/itmprm2d.dspf b/perp/qddssrc/itmprm2d.dspf new file mode 100644 index 00000000..048cc3d5 --- /dev/null +++ b/perp/qddssrc/itmprm2d.dspf @@ -0,0 +1,50 @@ + A DSPSIZ(24 80 *DS3) + A PRINT + A CA03(03 'Exit') + A CA05(05 'Refresh') + A CA12(12 'Cancel') + A R ITPSFL SFL + A 51 SFLNXTCHG + A SOPT 1A B 8 2 + A 50 DSPATR(RI) + A 50 DSPATR(PC) + A SIITEM 25A O 8 5 + A SIDESC 48A O 8 31 + A R ITPCTL SFLCTL(ITPSFL) + A SFLSIZ(0099) + A SFLPAG(0007) + A OVERLAY + A SFLDSPCTL + A N31 30 SFLDSP + A 31 SFLCLR + A N31 30 SFLEND(*MORE) + A 1 31'Item Number Prompt' + A DSPATR(HI) + A 2 2'Search (item/desc):' + A SSEARCH 30A B 2 35 + A 4 2'Type 1 to select an item.' + A 7 2'Opt' + A DSPATR(UL) + A 7 6'Item' + A DSPATR(UL) + A 7 31'Description' + A DSPATR(UL) + A R ITPFOOT + A 23 2'F3=Exit F5=Refresh F12=Ca- + A ncel' + A COLOR(BLU) + A R ITPNONE + A OVERLAY + A 10 20'** No items match this searc- + A h **' + A R ITPMSGSFL SFL + A SFLMSGRCD(24) + A SMSGKEY SFLMSGKEY + A SPGMQ SFLPGMQ(10) + A R ITPMSGCTL SFLCTL(ITPMSGSFL) + A OVERLAY + A N41 40 SFLDSP + A 41 SFLCLR + A N41 40 SFLEND + A SFLSIZ(0002) + A SFLPAG(0001) diff --git a/perp/qddssrc/perpdiag.dspf b/perp/qddssrc/perpdiag.dspf new file mode 100644 index 00000000..50f51587 --- /dev/null +++ b/perp/qddssrc/perpdiag.dspf @@ -0,0 +1,37 @@ + A* PERPDIAG menu + A DSPSIZ(24 80 *DS3) + A CHGINPDFT + A INDARA + A PRINT(*LIBL/QSYSPRT) + A* CRTMNU TYPE(*DSPF) requires a record format named PERPDIAG + A R PERPDIAG + A LOCK + A SLNO(01) + A CLRL(*ALL) + A ALWROL + A CF03 + A HELP + A HOME + A HLPRTN + A 1 2'PERPDIAG' + A COLOR(BLU) + A 1 25'PERP - Diagnostics / Smoke Tests' + A DSPATR(HI) + A COLOR(WHT) + A 3 2'Select one of the following:' + A COLOR(BLU) + A 5 7'1. Smoke test doc-sequence servi- + A ce' + A 6 7'2. Smoke test price-history serv- + A ice' + A 7 7'3. Smoke test warehouse coordina- + A te service' + A 8 7'4. Smoke test CoderFlow auto-app- + A roval hook' + A 9 7'5. Smoke test lot reconciliation + A service' + A 23 2'F3=Exit' + A COLOR(BLU) + A* CMDPROMPT Do not delete this DDS spec. + A 021 2'Selection: - + A ' diff --git a/perp/qddssrc/perpinvm.dspf b/perp/qddssrc/perpinvm.dspf new file mode 100644 index 00000000..ca463bf2 --- /dev/null +++ b/perp/qddssrc/perpinvm.dspf @@ -0,0 +1,35 @@ + A* PERPINVM menu + A DSPSIZ(24 80 *DS3) + A CHGINPDFT + A INDARA + A PRINT(*LIBL/QSYSPRT) + A* CRTMNU TYPE(*DSPF) requires a record format named PERPINVM + A R PERPINVM + A LOCK + A SLNO(01) + A CLRL(*ALL) + A ALWROL + A CF03 + A HELP + A HOME + A HLPRTN + A 1 2'PERPINVM' + A COLOR(BLU) + A 1 25'PERP - Inventory Master Data' + A DSPATR(HI) + A COLOR(WHT) + A 3 2'Select one of the following:' + A COLOR(BLU) + A 5 7'1. Work with units of measure (u- + A om)' + A 6 7'2. Work with item UOM conversion- + A s' + A 7 7'3. Work with item classes' + A 8 7'4. Work with items' + A 9 7'5. Work with item lots' + A 10 7'6. Work with warehouse layout' + A 23 2'F3=Exit' + A COLOR(BLU) + A* CMDPROMPT Do not delete this DDS spec. + A 021 2'Selection: - + A ' diff --git a/perp/qddssrc/perpmnu.dspf b/perp/qddssrc/perpmnu.dspf new file mode 100644 index 00000000..f8f2e888 --- /dev/null +++ b/perp/qddssrc/perpmnu.dspf @@ -0,0 +1,36 @@ + A* PERPMNU menu + A DSPSIZ(24 80 *DS3) + A CHGINPDFT + A INDARA + A PRINT(*LIBL/QSYSPRT) + A* CRTMNU TYPE(*DSPF) requires a record format named PERPMNU + A R PERPMNU + A LOCK + A SLNO(01) + A CLRL(*ALL) + A ALWROL + A CF03 + A HELP + A HOME + A HLPRTN + A 1 2'PERPMNU' + A COLOR(BLU) + A 1 25'PreSales ERP (PERP) - Main Menu' + A DSPATR(HI) + A COLOR(WHT) + A 3 2'Select one of the following:' + A COLOR(BLU) + A 5 7'1. Select company for session' + A 6 7'2. System Maintenance' + A 7 7'3. Inventory Master Data' + A 8 7'4. Vendor & Pricing' + A 9 7'5. Diagnostics / Smoke Tests' + A 10 7'6. Requisitioning' + A 11 7'7. Purchasing' + A 12 7'8. Receiving' + A 13 6'90. Sign off' + A 23 2'F3=Exit' + A COLOR(BLU) + A* CMDPROMPT Do not delete this DDS spec. + A 021 2'Selection: - + A ' diff --git a/perp/qddssrc/perppom.dspf b/perp/qddssrc/perppom.dspf new file mode 100644 index 00000000..05b43595 --- /dev/null +++ b/perp/qddssrc/perppom.dspf @@ -0,0 +1,32 @@ + A* PERPPOM menu + A DSPSIZ(24 80 *DS3) + A CHGINPDFT + A INDARA + A PRINT(*LIBL/QSYSPRT) + A* CRTMNU TYPE(*DSPF) requires a record format named PERPPOM + A R PERPPOM + A LOCK + A SLNO(01) + A CLRL(*ALL) + A ALWROL + A CF03 + A HELP + A HOME + A HLPRTN + A 1 2'PERPPOM' + A COLOR(BLU) + A 1 25'PERP - Purchasing' + A DSPATR(HI) + A COLOR(WHT) + A 3 2'Select one of the following:' + A COLOR(BLU) + A 5 7'1. Manual PO entry' + A 6 7'2. Create POs from approved requi- + A sitions' + A 7 7'3. Blanket PO schedule maintenance' + A 8 7'4. Browse / inquire POs' + A 23 2'F3=Exit' + A COLOR(BLU) + A* CMDPROMPT Do not delete this DDS spec. + A 021 2'Selection: - + A ' diff --git a/perp/qddssrc/perprcvm.dspf b/perp/qddssrc/perprcvm.dspf new file mode 100644 index 00000000..b0df9fe5 --- /dev/null +++ b/perp/qddssrc/perprcvm.dspf @@ -0,0 +1,30 @@ + A* PERPRCVM menu + A DSPSIZ(24 80 *DS3) + A CHGINPDFT + A INDARA + A PRINT(*LIBL/QSYSPRT) + A* CRTMNU TYPE(*DSPF) requires a record format named PERPRCVM + A R PERPRCVM + A LOCK + A SLNO(01) + A CLRL(*ALL) + A ALWROL + A CF03 + A HELP + A HOME + A HLPRTN + A 1 2'PERPRCVM' + A COLOR(BLU) + A 1 25'PERP - Receiving & Reconcilia- + A tion' + A DSPATR(HI) + A COLOR(WHT) + A 3 2'Select one of the following:' + A COLOR(BLU) + A 5 7'1. Receive against a PO' + A 6 7'2. Reconciliation log browse' + A 23 2'F3=Exit' + A COLOR(BLU) + A* CMDPROMPT Do not delete this DDS spec. + A 021 2'Selection: - + A ' diff --git a/perp/qddssrc/perpreqm.dspf b/perp/qddssrc/perpreqm.dspf new file mode 100644 index 00000000..9050272b --- /dev/null +++ b/perp/qddssrc/perpreqm.dspf @@ -0,0 +1,29 @@ + A* PERPREQM menu + A DSPSIZ(24 80 *DS3) + A CHGINPDFT + A INDARA + A PRINT(*LIBL/QSYSPRT) + A* CRTMNU TYPE(*DSPF) requires a record format named PERPREQM + A R PERPREQM + A LOCK + A SLNO(01) + A CLRL(*ALL) + A ALWROL + A CF03 + A HELP + A HOME + A HLPRTN + A 1 2'PERPREQM' + A COLOR(BLU) + A 1 25'PERP - Requisitioning' + A DSPATR(HI) + A COLOR(WHT) + A 3 2'Select one of the following:' + A COLOR(BLU) + A 5 7'1. Enter/submit requisitions' + A 6 7'2. Approve/reject requisitions' + A 23 2'F3=Exit' + A COLOR(BLU) + A* CMDPROMPT Do not delete this DDS spec. + A 021 2'Selection: - + A ' diff --git a/perp/qddssrc/perpseld.dspf b/perp/qddssrc/perpseld.dspf new file mode 100644 index 00000000..e2b04eda --- /dev/null +++ b/perp/qddssrc/perpseld.dspf @@ -0,0 +1,81 @@ + A DSPSIZ(24 80 *DS3) + A PRINT + A CA03(03 'Exit') + A CA05(05 'Refresh') + A CA06(06 'Add') + A CA12(12 'Cancel') + A R COSFL SFL + A 51 SFLNXTCHG + A SOPT 1A B 8 4 + A 50 DSPATR(RI) + A 50 DSPATR(PC) + A SCOMPC 3A O 8 9 + A SCOMPN 60A O 8 15 + A SCURR 20A O 8 76 + A R COCTL SFLCTL(COSFL) + A SFLSIZ(0099) + A SFLPAG(0007) + A OVERLAY + A SFLDSPCTL + A N31 30 SFLDSP + A 31 SFLCLR + A N31 30 SFLEND(*MORE) + A 1 30'Select PERP Company' + A DSPATR(HI) + A 2 2'Currently selected . . :' + A SCURSEL 3A O 2 30DSPATR(HI) + A 4 2'Type option, press Enter.' + A 5 4'1=Select this company 2=Chan- + A ge company info' + A 7 4'Opt' + A DSPATR(UL) + A 7 9'Code' + A DSPATR(UL) + A 7 15'Company name' + A DSPATR(UL) + A 7 76'Curr' + A DSPATR(UL) + A R COFOOT + A 23 2'F3=Exit F5=Refresh F6=Add - + A F12=Cancel' + A COLOR(BLU) + A R COEDIT + A OVERLAY + A 1 30'Edit Company' + A DSPATR(HI) + A 2 2'Mode:' + A EMODE 1A O 2 8 + A 3 2'Company code:' + A ECOMPC 3A B 3 17 + A 60 DSPATR(PR) + A 4 2'Company name:' + A ECOMPNM 60A B 4 17CHECK(LC) + A 5 2'Address:' + A EADDR1 60A B 5 17CHECK(LC) + A 6 2'City:' + A ECITY 40A B 6 17CHECK(LC) + A 6 59'State:' + A ESTATE 3A B 6 66 + A 7 2'Postal code:' + A EPOSTCD 12A B 7 17 + A 7 36'Country:' + A ECNTRY 3A B 7 45 + A 8 2'Base currency:' + A EBASECUR 20A B 8 17 + A 23 2'Enter=Save F12=Cancel' + A COLOR(BLU) + A R CONONE + A OVERLAY + A 10 20'** No active companies to di- + A splay **' + A R COMSGSFL SFL + A SFLMSGRCD(24) + A SMSGKEY SFLMSGKEY + A SPGMQ SFLPGMQ(10) + A R COMSGCTL SFLCTL(COMSGSFL) + A OVERLAY + A N41 40 SFLDSP + A 41 SFLCLR + A N41 40 SFLEND + A SFLSIZ(0002) + A SFLPAG(0001) diff --git a/perp/qddssrc/perpsysm.dspf b/perp/qddssrc/perpsysm.dspf new file mode 100644 index 00000000..9342dfc2 --- /dev/null +++ b/perp/qddssrc/perpsysm.dspf @@ -0,0 +1,30 @@ + A* PERPSYSM menu + A DSPSIZ(24 80 *DS3) + A CHGINPDFT + A INDARA + A PRINT(*LIBL/QSYSPRT) + A* CRTMNU TYPE(*DSPF) requires a record format named PERPSYSM + A R PERPSYSM + A LOCK + A SLNO(01) + A CLRL(*ALL) + A ALWROL + A CF03 + A HELP + A HOME + A HLPRTN + A 1 2'PERPSYSM' + A COLOR(BLU) + A 1 25'PERP - System Maintenance' + A DSPATR(HI) + A COLOR(WHT) + A 3 2'Select one of the following:' + A COLOR(BLU) + A 5 7'1. Work with system codes (code_- + A master)' + A 6 7'2. Work with PERP users' + A 23 2'F3=Exit' + A COLOR(BLU) + A* CMDPROMPT Do not delete this DDS spec. + A 021 2'Selection: - + A ' diff --git a/perp/qddssrc/perpvndm.dspf b/perp/qddssrc/perpvndm.dspf new file mode 100644 index 00000000..b3f8b0bc --- /dev/null +++ b/perp/qddssrc/perpvndm.dspf @@ -0,0 +1,31 @@ + A* PERPVNDM menu + A DSPSIZ(24 80 *DS3) + A CHGINPDFT + A INDARA + A PRINT(*LIBL/QSYSPRT) + A* CRTMNU TYPE(*DSPF) requires a record format named PERPVNDM + A R PERPVNDM + A LOCK + A SLNO(01) + A CLRL(*ALL) + A ALWROL + A CF03 + A HELP + A HOME + A HLPRTN + A 1 2'PERPVNDM' + A COLOR(BLU) + A 1 25'PERP - Vendor & Pricing' + A DSPATR(HI) + A COLOR(WHT) + A 3 2'Select one of the following:' + A COLOR(BLU) + A 5 7'1. Work with vendors' + A 6 7'2. Work with item-vendor profile- + A s' + A 7 7'3. Work with item-vendor prices' + A 23 2'F3=Exit' + A COLOR(BLU) + A* CMDPROMPT Do not delete this DDS spec. + A 021 2'Selection: - + A ' diff --git a/perp/qddssrc/pobrwd.dspf b/perp/qddssrc/pobrwd.dspf new file mode 100644 index 00000000..870a1f6a --- /dev/null +++ b/perp/qddssrc/pobrwd.dspf @@ -0,0 +1,155 @@ + A DSPSIZ(24 80 *DS3) + A PRINT + A CA03(03 'Exit') + A CA05(05 'Refresh') + A CA12(12 'Cancel/Back') + A R BSFL SFL + A 51 SFLNXTCHG + A BSOPT 1A B 12 2 + A 50 DSPATR(RI) + A 50 DSPATR(PC) + A BSPONBR 10A O 12 5 + A BSVNDR 10A O 12 16 + A BSVNDNM 25A O 12 27 + A BSBUYER 10A O 12 53 + A BSORDDT L O 12 64DATFMT(*MDY) + A BSSTAT 6A O 12 75 + A R BSCTL SFLCTL(BSFL) + A SFLSIZ(0099) + A SFLPAG(0006) + A OVERLAY + A SFLDSPCTL + A N31 30 SFLDSP + A 31 SFLCLR + A N31 30 SFLEND(*MORE) + A 1 30'Purchase Order Browse' + A DSPATR(HI) + A 2 2'Company:' + A LCOMPDSP 3A O 2 11 + A 3 2'Filter -- Status:' + A FSTAT 10A B 3 20 + A 3 32'Vendor:' + A FVND 10A B 3 40 + A 3 52'Buyer:' + A FBUY 10A B 3 59 + A 4 2'From date:' + A FFRDT L B 4 13DATFMT(*MDY) + A 4 27'To date:' + A FTODT L B 4 36DATFMT(*MDY) + A 4 50'(blank = no filter)' + A 6 2'Enter=Apply filter' + A 8 2'Type option, press Enter.' + A 9 4'5=Detail 9=Blanket schedules' + A 11 2'Opt' + A DSPATR(UL) + A 11 6'PO #' + A DSPATR(UL) + A 11 16'Vendor' + A DSPATR(UL) + A 11 27'Vendor Name' + A DSPATR(UL) + A 11 53'Buyer' + A DSPATR(UL) + A 11 64'Order Dt' + A DSPATR(UL) + A 11 75'Status' + A DSPATR(UL) + A R BFOOT + A OVERLAY + A 23 2'F3=Exit F5=Refresh F12=Back' + A COLOR(BLU) + A R BNOPO + A OVERLAY + A 14 20'No purchase orders match filter.' + A R BDETAIL + A OVERLAY + A 1 25'PO Detail' + A DSPATR(HI) + A 2 2'PO #:' + A DDPONBR 10A O 2 8 + A 2 22'Vendor:' + A DDVNDR 10A O 2 30 + A DDVNDNM 30A O 2 41 + A 3 2'Buyer:' + A DDBUYR 10A O 3 9 + A 3 22'Order Date:' + A DDORDDT L O 3 34DATFMT(*MDY) + A 3 47'Status:' + A DDSTAT 20A O 3 55 + A 4 2'Total Amount:' + A DDTOT 15Y 2O 4 16EDTCDE(3) + A 4 34'Currency:' + A DDCURR 5A O 4 44 + A 6 2'Lines:' + A 7 2'Line' + A DSPATR(UL) + A 7 7'Item' + A DSPATR(UL) + A 7 39'Ord' + A DSPATR(UL) + A 7 49'Rcv' + A DSPATR(UL) + A 7 58'Open' + A DSPATR(UL) + A 7 67'Price' + A DSPATR(UL) + A 7 73'Src Req' + A DSPATR(UL) + A 60 L1LN 3Y 0O 8 2EDTCDE(3) + A 60 L1ITEM 25A O 8 7 + A 60 L1ORD 7Y 2O 8 33EDTCDE(3) + A 60 L1RCV 7Y 2O 8 43EDTCDE(3) + A 60 L1OPEN 7Y 2O 8 53EDTCDE(3) + A 60 L1PRC 7Y 2O 8 63EDTCDE(3) + A 60 L1SRC 8A O 8 73 + A 61 L2LN 3Y 0O 9 2EDTCDE(3) + A 61 L2ITEM 25A O 9 7 + A 61 L2ORD 7Y 2O 9 33EDTCDE(3) + A 61 L2RCV 7Y 2O 9 43EDTCDE(3) + A 61 L2OPEN 7Y 2O 9 53EDTCDE(3) + A 61 L2PRC 7Y 2O 9 63EDTCDE(3) + A 61 L2SRC 8A O 9 73 + A 62 L3LN 3Y 0O 10 2EDTCDE(3) + A 62 L3ITEM 25A O 10 7 + A 62 L3ORD 7Y 2O 10 33EDTCDE(3) + A 62 L3RCV 7Y 2O 10 43EDTCDE(3) + A 62 L3OPEN 7Y 2O 10 53EDTCDE(3) + A 62 L3PRC 7Y 2O 10 63EDTCDE(3) + A 62 L3SRC 8A O 10 73 + A 63 L4LN 3Y 0O 11 2EDTCDE(3) + A 63 L4ITEM 25A O 11 7 + A 63 L4ORD 7Y 2O 11 33EDTCDE(3) + A 63 L4RCV 7Y 2O 11 43EDTCDE(3) + A 63 L4OPEN 7Y 2O 11 53EDTCDE(3) + A 63 L4PRC 7Y 2O 11 63EDTCDE(3) + A 63 L4SRC 8A O 11 73 + A 64 L5LN 3Y 0O 12 2EDTCDE(3) + A 64 L5ITEM 25A O 12 7 + A 64 L5ORD 7Y 2O 12 33EDTCDE(3) + A 64 L5RCV 7Y 2O 12 43EDTCDE(3) + A 64 L5OPEN 7Y 2O 12 53EDTCDE(3) + A 64 L5PRC 7Y 2O 12 63EDTCDE(3) + A 64 L5SRC 8A O 12 73 + A 65 L6LN 3Y 0O 13 2EDTCDE(3) + A 65 L6ITEM 25A O 13 7 + A 65 L6ORD 7Y 2O 13 33EDTCDE(3) + A 65 L6RCV 7Y 2O 13 43EDTCDE(3) + A 65 L6OPEN 7Y 2O 13 53EDTCDE(3) + A 65 L6PRC 7Y 2O 13 63EDTCDE(3) + A 65 L6SRC 8A O 13 73 + A 34 15 2'More lines exist -- not all shown.' + A 17 2'Schedules:' + A DDSCH 50A O 17 13 + A 23 2'F5=Refresh F12=Back' + A COLOR(BLU) + A R RMSGSFL SFL + A SFLMSGRCD(24) + A SMSGKEY SFLMSGKEY + A SPGMQ SFLPGMQ(10) + A R RMSGCTL SFLCTL(RMSGSFL) + A OVERLAY + A N41 40 SFLDSP + A 41 SFLCLR + A N41 40 SFLEND + A SFLSIZ(0002) + A SFLPAG(0001) diff --git a/perp/qddssrc/poentd.dspf b/perp/qddssrc/poentd.dspf new file mode 100644 index 00000000..891fd186 --- /dev/null +++ b/perp/qddssrc/poentd.dspf @@ -0,0 +1,116 @@ + A DSPSIZ(24 80 *DS3) + A PRINT + A CA03(03 'Exit') + A CA05(05 'Refresh') + A CA06(06 'Add') + A CA08(08 'Submit') + A CA12(12 'Cancel') + A R PHEAD + A OVERLAY + A 1 30'Purchase Order Entry' + A DSPATR(HI) + A 2 2'Company:' + A HCOMPDSP 3A O 2 11 + A 3 2'Vendor Code:' + A HVNDCD 10A B 3 15 + A HVNDNM 30A O 3 28 + A 4 2'Buyer:' + A HBUYCD 10A O 4 9 + A DSPATR(HI) + A 4 22'(defaulted from vendor)' + A 5 2'Order Date:' + A HORDDT L B 5 14DATFMT(*MDY) + A 5 26'(MM/DD/YY)' + A 6 2'Notes:' + A HNOTES 50A B 6 9 + A 23 2'F3=Exit F12=Cancel' + A COLOR(BLU) + A R PLSFL SFL + A 51 SFLNXTCHG + A SLOPT 1A B 9 2 + A 50 DSPATR(RI) + A 50 DSPATR(PC) + A SLLINE 3Y 0O 9 5 + A SLITEM 25A O 9 10 + A SLQTY 15Y 4O 9 36EDTCDE(3) + A SLUOM 5A O 9 56 + A SLPRICE 15Y 4O 9 62EDTCDE(3) + A R PLCTL SFLCTL(PLSFL) + A SFLSIZ(0099) + A SFLPAG(0007) + A OVERLAY + A SFLDSPCTL + A N31 30 SFLDSP + A 31 SFLCLR + A N31 30 SFLEND(*MORE) + A 1 30'Purchase Order Lines' + A DSPATR(HI) + A 2 2'PO #:' + A DPONBR 15A O 2 8 + A 2 40'Vendor:' + A DVNDCD 10A O 2 48 + A DVNDNM 22A O 2 59 + A 3 2'Buyer:' + A DBUYCD 10A O 3 9 + A 3 40'Order Date:' + A DORDDT L O 3 52DATFMT(*MDY) + A 4 2'Status:' + A DSTATUS 20A O 4 10 + A 4 40'Total Amount:' + A DTOTAMT 15Y 2O 4 54EDTCDE(3) + A 6 2'Type option, press Enter.' + A 7 4'2=Change 4=Delete' + A 8 2'Opt' + A DSPATR(UL) + A 8 6'Line' + A DSPATR(UL) + A 8 11'Item' + A DSPATR(UL) + A 8 48'Ord Qty' + A DSPATR(UL) + A 8 56'UOM' + A DSPATR(UL) + A 8 71'Unit Price' + A DSPATR(UL) + A R PLFOOT + A OVERLAY + A 23 2'F3=Exit F5=Refresh F6=Add F8=Su- + A bmit F12=Cancel' + A COLOR(BLU) + A R PNOLIN + A OVERLAY + A 11 20'No lines yet. Press F6=Add.' + A R PLEDIT + A OVERLAY + A 1 25'Add/Change PO Line' + A DSPATR(HI) + A 2 2'Mode:' + A EMODE 1A O 2 8 + A 3 2'Item Number:' + A EITEM 25A B 3 15 + A EITMDSC 39A O 3 42 + A DSPATR(HI) + A 4 2'Quantity:' + A EQTY 15Y 4B 4 12EDTCDE(3) + A 5 2'UOM:' + A EUOM 5A B 5 7 + A 5 15'(blank = default from item)' + A 6 2'Unit Price:' + A EPRICE 15Y 4B 6 14EDTCDE(3) + A 6 33'(0 = default from vendor)' + A 7 2'Expected Recv Date:' + A EEXPDT L B 7 22DATFMT(*MDY) + A 7 34'(MM/DD/YY, blank = none)' + A 23 2'Enter=Save F12=Cancel' + A COLOR(BLU) + A R PMSGSFL SFL + A SFLMSGRCD(24) + A SMSGKEY SFLMSGKEY + A SPGMQ SFLPGMQ(10) + A R PMSGCTL SFLCTL(PMSGSFL) + A OVERLAY + A N41 40 SFLDSP + A 41 SFLCLR + A N41 40 SFLEND + A SFLSIZ(0002) + A SFLPAG(0001) diff --git a/perp/qddssrc/poprmtd.dspf b/perp/qddssrc/poprmtd.dspf new file mode 100644 index 00000000..82fc96d4 --- /dev/null +++ b/perp/qddssrc/poprmtd.dspf @@ -0,0 +1,56 @@ + A DSPSIZ(24 80 *DS3) + A PRINT + A CA03(03 'Exit') + A CA05(05 'Refresh') + A CA12(12 'Cancel') + A R PPSFL SFL + A 51 SFLNXTCHG + A SOPT 1A B 8 2 + A 50 DSPATR(RI) + A 50 DSPATR(PC) + A SIPONBR 15Y 0O 8 5EDTCDE(3) + A SIVNDR 10A O 8 22 + A SIVNDNM 30A O 8 33 + A SISTAT 10A O 8 65 + A R PPCTL SFLCTL(PPSFL) + A SFLSIZ(0099) + A SFLPAG(0007) + A OVERLAY + A SFLDSPCTL + A N31 30 SFLDSP + A 31 SFLCLR + A N31 30 SFLEND(*MORE) + A 1 26'PO Number Prompt' + A DSPATR(HI) + A 2 2'Search (PO # or vendor):' + A SSEARCH 30A B 2 28 + A 4 2'Type 1 to select a PO.' + A 7 2'Opt' + A DSPATR(UL) + A 7 6'PO #' + A DSPATR(UL) + A 7 22'Vendor' + A DSPATR(UL) + A 7 33'Vendor Name' + A DSPATR(UL) + A 7 65'Status' + A DSPATR(UL) + A R PPFOOT + A 23 2'F3=Exit F5=Refresh F12=Ca- + A ncel' + A COLOR(BLU) + A R PPNONE + A OVERLAY + A 10 20'** No POs awaiting receipt for - + A this search **' + A R PPMSGSFL SFL + A SFLMSGRCD(24) + A SMSGKEY SFLMSGKEY + A SPGMQ SFLPGMQ(10) + A R PPMSGCTL SFLCTL(PPMSGSFL) + A OVERLAY + A N41 40 SFLDSP + A 41 SFLCLR + A N41 40 SFLEND + A SFLSIZ(0002) + A SFLPAG(0001) diff --git a/perp/qddssrc/poreqd.dspf b/perp/qddssrc/poreqd.dspf new file mode 100644 index 00000000..3f67870d --- /dev/null +++ b/perp/qddssrc/poreqd.dspf @@ -0,0 +1,112 @@ + A DSPSIZ(24 80 *DS3) + A PRINT + A CA03(03 'Exit') + A CA05(05 'Refresh') + A CF06(06 'Convert/Confirm') + A CA12(12 'Cancel/Back') + A R SSFL SFL + A 51 SFLNXTCHG + A SSOPT 1A B 9 2 + A 50 DSPATR(RI) + A 50 DSPATR(PC) + A SSREQNBR 8A O 9 5 + A SSREQBY 10A O 9 14 + A SSNEEDBY L O 9 27DATFMT(*MDY) + A SSVNDR 10A O 9 36 + A SSVNDNM 25A O 9 47 + A SSTOTEST 6Y 2O 9 73EDTCDE(3) + A R SSCTL SFLCTL(SSFL) + A SFLSIZ(0099) + A SFLPAG(0007) + A OVERLAY + A SFLDSPCTL + A N31 30 SFLDSP + A 31 SFLCLR + A N31 30 SFLEND(*MORE) + A 1 22'Create POs from Approved Requisi- + A tions' + A DSPATR(HI) + A 2 2'Company:' + A LCOMPDSP 3A O 2 11 + A 6 2'Type option 1=Select, press Enter- + A , then F6=Convert.' + A 8 2'Opt' + A DSPATR(UL) + A 8 6'Req #' + A DSPATR(UL) + A 8 14'Requested By' + A DSPATR(UL) + A 8 27'Need By' + A DSPATR(UL) + A 8 36'Vendor' + A DSPATR(UL) + A 8 47'Vendor Name' + A DSPATR(UL) + A 8 73'Est Cost' + A DSPATR(UL) + A R SFOOT + A OVERLAY + A 23 2'F3=Exit F5=Refresh F6=Convert - + A F12=Cancel' + A COLOR(BLU) + A R SNOSUB + A OVERLAY + A 11 20'No approved requisitions to conv- + A ert.' + A R SPREV + A OVERLAY + A 1 25'Preview - POs to Create' + A DSPATR(HI) + A 2 2'Company:' + A PCOMPDSP 3A O 2 11 + A 3 2'Selected requisitions:' + A PSELCNT 4Y 0O 3 26EDTCDE(3) + A 3 34'lines:' + A PLNCNT 4Y 0O 3 41EDTCDE(3) + A 3 47'PO count:' + A PPOCNT 4Y 0O 3 57EDTCDE(3) + A 5 2'The following POs will be created- + A :' + A 6 2'Vendor' + A DSPATR(UL) + A 6 12'Vendor Name' + A DSPATR(UL) + A 6 43'Lines' + A DSPATR(UL) + A 6 51'Total Amount' + A DSPATR(UL) + A 60 P1VNDR 10A O 7 2 + A 60 P1VNDNM 30A O 7 12 + A 60 P1LNS 4Y 0O 7 43EDTCDE(3) + A 60 P1TOT 15Y 2O 7 51EDTCDE(3) + A 61 P2VNDR 10A O 8 2 + A 61 P2VNDNM 30A O 8 12 + A 61 P2LNS 4Y 0O 8 43EDTCDE(3) + A 61 P2TOT 15Y 2O 8 51EDTCDE(3) + A 62 P3VNDR 10A O 9 2 + A 62 P3VNDNM 30A O 9 12 + A 62 P3LNS 4Y 0O 9 43EDTCDE(3) + A 62 P3TOT 15Y 2O 9 51EDTCDE(3) + A 63 P4VNDR 10A O 10 2 + A 63 P4VNDNM 30A O 10 12 + A 63 P4LNS 4Y 0O 10 43EDTCDE(3) + A 63 P4TOT 15Y 2O 10 51EDTCDE(3) + A 64 P5VNDR 10A O 11 2 + A 64 P5VNDNM 30A O 11 12 + A 64 P5LNS 4Y 0O 11 43EDTCDE(3) + A 64 P5TOT 15Y 2O 11 51EDTCDE(3) + A 34 13 2'More vendors exist -- not all sho- + A wn.' + A 15 2'F6=Confirm create F12=Back' + A COLOR(BLU) + A R RMSGSFL SFL + A SFLMSGRCD(24) + A SMSGKEY SFLMSGKEY + A SPGMQ SFLPGMQ(10) + A R RMSGCTL SFLCTL(RMSGSFL) + A OVERLAY + A N41 40 SFLDSP + A 41 SFLCLR + A N41 40 SFLEND + A SFLSIZ(0002) + A SFLPAG(0001) diff --git a/perp/qddssrc/poschd.dspf b/perp/qddssrc/poschd.dspf new file mode 100644 index 00000000..adfb6cfa --- /dev/null +++ b/perp/qddssrc/poschd.dspf @@ -0,0 +1,111 @@ + A DSPSIZ(24 80 *DS3) + A PRINT + A CA03(03 'Exit') + A CA05(05 'Refresh') + A CA06(06 'Add') + A CA12(12 'Cancel') + A R HHEAD + A OVERLAY + A 1 25'Blanket PO Schedule' + A DSPATR(HI) + A 2 2'Company:' + A HCOMPDSP 3A O 2 11 + A 3 2'PO Number:' + A HPONBR 10A B 3 13 + A 4 2'Line Number:' + A HLINE 3Y 0B 4 15EDTCDE(3) + A 23 2'Enter=Load F3=Exit F12=Cance- + A l' + A COLOR(BLU) + A R HSFL SFL + A 51 SFLNXTCHG + A SLOPT 1A B 10 2 + A 50 DSPATR(RI) + A 50 DSPATR(PC) + A SLSEQ 3Y 0O 10 5 + A SLSCHDT L O 10 10DATFMT(*MDY) + A SLSCHQTY 15Y 4O 10 22EDTCDE(3) + A SLRCVQTY 15Y 4O 10 40EDTCDE(3) + A SLSCHNOT 30A O 10 58 + A R HSCTL SFLCTL(HSFL) + A SFLSIZ(0099) + A SFLPAG(0007) + A OVERLAY + A SFLDSPCTL + A N31 30 SFLDSP + A 31 SFLCLR + A N31 30 SFLEND(*MORE) + A 1 25'Blanket PO Schedule' + A DSPATR(HI) + A 2 2'PO #:' + A DPONBR 10A O 2 8 + A 2 20'Line:' + A DLINE 3Y 0O 2 26EDTCDE(3) + A 2 35'Item:' + A DITEM 25A O 2 41 + A 3 2'Vendor:' + A DVNDCD 10A O 3 10 + A 3 22'Ord Qty:' + A DORDQTY 15Y 4O 3 31EDTCDE(3) + A 3 58'UOM:' + A DUOM 5A O 3 64 + A 4 2'Sched Total:' + A DSCHTOT 15Y 4O 4 15EDTCDE(3) + A 4 32'Recv Total:' + A DRCVTOT 15Y 4O 4 44EDTCDE(3) + A 70 5 2'** Scheduled qty exceeds ordered qty *- + A *' + A COLOR(RED) + A DSPATR(HI) + A 7 2'Type option, press Enter.' + A 8 4'2=Change 4=Delete' + A 9 2'Opt' + A DSPATR(UL) + A 9 6'Seq' + A DSPATR(UL) + A 9 10'Scheduled' + A DSPATR(UL) + A 9 22'Sched Qty' + A DSPATR(UL) + A 9 40'Recv Qty' + A DSPATR(UL) + A 9 58'Notes' + A DSPATR(UL) + A R HFOOT + A OVERLAY + A 23 2'F3=Exit F5=Refresh F6=Add F12=- + A Cancel' + A COLOR(BLU) + A R HNOSCH + A OVERLAY + A 12 20'No schedules yet. Press F6=Add.' + A R HEDIT + A OVERLAY + A 1 25'Add/Change Schedule' + A DSPATR(HI) + A 2 2'Mode:' + A EMODE 1A O 2 8 + A 3 2'Seq:' + A ESEQ 3Y 0O 3 7EDTCDE(3) + A 4 2'Scheduled Date:' + A ESCHDT L B 4 18DATFMT(*MDY) + A 4 30'(MM/DD/YY)' + A 5 2'Scheduled Qty:' + A ESCHQTY 15Y 4B 5 17EDTCDE(3) + A 6 2'Received Qty:' + A ERCVQTY 15Y 4B 6 16EDTCDE(3) + A 7 2'Notes:' + A ENOTES 50A B 7 9 + A 23 2'Enter=Save F12=Cancel' + A COLOR(BLU) + A R HMSGSFL SFL + A SFLMSGRCD(24) + A SMSGKEY SFLMSGKEY + A SPGMQ SFLPGMQ(10) + A R HMSGCTL SFLCTL(HMSGSFL) + A OVERLAY + A N41 40 SFLDSP + A 41 SFLCLR + A N41 40 SFLEND + A SFLSIZ(0002) + A SFLPAG(0001) diff --git a/perp/qddssrc/rcnbrwd.dspf b/perp/qddssrc/rcnbrwd.dspf new file mode 100644 index 00000000..11b8ebe9 --- /dev/null +++ b/perp/qddssrc/rcnbrwd.dspf @@ -0,0 +1,92 @@ + A DSPSIZ(24 80 *DS3) + A PRINT + A CA03(03 'Exit') + A CA05(05 'Refresh') + A CA12(12 'Cancel/Back') + A R LSFL SFL + A 51 SFLNXTCHG + A LSOPT 1A B 11 2 + A 50 DSPATR(RI) + A 50 DSPATR(PC) + A LSID 10Y 0O 11 5EDTCDE(3) + A LSITEM 25A O 11 17 + A LSQBEF 11Y 4O 11 43EDTCDE(3) + A LSQAFT 11Y 4O 11 57EDTCDE(3) + A LSRCNBY 10A O 11 70 + A R LCTL SFLCTL(LSFL) + A SFLSIZ(0099) + A SFLPAG(0006) + A OVERLAY + A SFLDSPCTL + A N31 30 SFLDSP + A 31 SFLCLR + A N31 30 SFLEND(*MORE) + A 1 22'Reconciliation Log Browse' + A DSPATR(HI) + A 2 2'Company:' + A LCOMPDSP 3A O 2 11 + A 3 2'Filter -- Item:' + A FITEM 25A B 3 18 + A 3 46'Reconciled By:' + A FRCNBY 18A B 3 62 + A 4 2'From date:' + A FFRDT L B 4 13DATFMT(*ISO) + A 4 27'To date:' + A FTODT L B 4 36DATFMT(*ISO) + A 4 50'(blank = no filter)' + A 6 2'Enter=Apply filter' + A 8 2'Type option, press Enter.' + A 9 4'5=Detail' + A 10 2'Opt' + A DSPATR(UL) + A 10 5'ID' + A DSPATR(UL) + A 10 17'Item' + A DSPATR(UL) + A 10 43'Qty Before' + A DSPATR(UL) + A 10 57'Qty After' + A DSPATR(UL) + A 10 70'By' + A DSPATR(UL) + A R LFOOT + A OVERLAY + A 23 2'F3=Exit F5=Refresh F12=Back' + A COLOR(BLU) + A R LNOROWS + A OVERLAY + A 13 15'No reconciliation log entries - + A match filter.' + A R LDETAIL + A OVERLAY + A 1 27'Reconciliation Detail' + A DSPATR(HI) + A 2 2'ID:' + A DDID 10Y 0O 2 7EDTCDE(3) + A 2 20'Item:' + A DDITEM 25A O 2 26 + A 3 2'Run Timestamp:' + A DDRUNTS 26A O 3 17 + A 5 2'Qty Before:' + A DDQBEF 11Y 4O 5 14EDTCDE(3) + A 5 30'Lot Sum Before:' + A DDLSUM 11Y 4O 5 46EDTCDE(3) + A 6 2'Qty After:' + A DDQAFT 11Y 4O 6 14EDTCDE(3) + A 7 2'Reconciled By:' + A DDRCNBY 18A O 7 17 + A 8 2'Notes:' + A DDNOTES 70A O 8 9 + A 23 2'F5=Refresh F12=Back' + A COLOR(BLU) + A R RMSGSFL SFL + A SFLMSGRCD(24) + A SMSGKEY SFLMSGKEY + A SPGMQ SFLPGMQ(10) + A R RMSGCTL SFLCTL(RMSGSFL) + A OVERLAY + A N41 40 SFLDSP + A 41 SFLCLR + A N41 40 SFLEND + A SFLSIZ(0002) + A SFLPAG(0001) diff --git a/perp/qddssrc/rcventd.dspf b/perp/qddssrc/rcventd.dspf new file mode 100644 index 00000000..71ad37fb --- /dev/null +++ b/perp/qddssrc/rcventd.dspf @@ -0,0 +1,118 @@ + A DSPSIZ(24 80 *DS3) + A PRINT + A CA03(03 'Exit') + A CA04(04 'Prompt') + A CA05(05 'Refresh') + A CA12(12 'Cancel') + A R RHEAD + A OVERLAY + A 1 28'Receipt Entry' + A DSPATR(HI) + A 2 2'Company:' + A HCOMPDSP 3A O 2 11 + A 3 2'PO Number:' + A HPONBR 15Y 0B 3 13EDTCDE(3) + A 3 31'Vendor:' + A HVNDNM 30A O 3 39 + A 4 2'PO Status:' + A HPOSTAT 20A O 4 13 + A 5 2'Receipt Date:' + A HRCPDT L B 5 16DATFMT(*ISO) + A 5 28'(YYYY-MM-DD)' + A 6 2'Received By:' + A HRCVBY 10A B 6 16 + A HRCVNM 30A O 6 28 + A 7 2'Notes:' + A HNOTES 50A B 7 9 + A 23 2'F3=Exit F4=Prompt F12=Cancel' + A COLOR(BLU) + A R RLSFL SFL + A 51 SFLNXTCHG + A SLOPT 1A B 9 2 + A 50 DSPATR(RI) + A 50 DSPATR(PC) + A SLLINE 3Y 0O 9 7EDTCDE(3) + A SLITEM 25A O 9 12 + A SLDESC 20A O 9 38 + A SLOPEN 11Y 4O 9 59EDTCDE(3) + A SLUOM 5A O 9 72 + A R RLCTL SFLCTL(RLSFL) + A SFLSIZ(0099) + A SFLPAG(0007) + A OVERLAY + A SFLDSPCTL + A N31 30 SFLDSP + A 31 SFLCLR + A N31 30 SFLEND(*MORE) + A 1 27'Purchase Order Receiving' + A DSPATR(HI) + A 2 2'PO #:' + A DPONBR 15A O 2 8 + A 2 30'Vendor:' + A DVNDR 10A O 2 38 + A DVNDNM 25A O 2 49 + A 3 2'Received By:' + A DRCVBY 10A O 3 16 + A DRCVNM 30A O 3 28 + A 4 2'Receipt Date:' + A DRCPDT L O 4 16DATFMT(*ISO) + A 4 30'PO Status:' + A DPOSTAT 20A O 4 41 + A 6 2'Type 1=Receive next to a line, - + A press Enter.' + A 7 2'Opt' + A DSPATR(UL) + A 7 7'Line' + A DSPATR(UL) + A 7 12'Item' + A DSPATR(UL) + A 7 38'Description' + A DSPATR(UL) + A 7 59'Open Qty' + A DSPATR(UL) + A 7 72'UOM' + A DSPATR(UL) + A R RLFOOT + A OVERLAY + A 23 2'F3=Exit F5=Refresh F12=Cancel' + A COLOR(BLU) + A R RNOLIN + A OVERLAY + A 11 15'No open lines for this PO -- eve- + A rything has been received.' + A R RLEDIT + A OVERLAY + A 1 25'Receive PO Line' + A DSPATR(HI) + A 2 2'Line:' + A ELINE 3Y 0O 2 8EDTCDE(3) + A 2 20'Item:' + A EITEM 25A O 2 26 + A 3 2'Description:' + A EDESC 30A O 3 16 + A 4 2'Open Qty:' + A EOPEN 11Y 4O 4 12EDTCDE(3) + A 4 30'Vendor UOM:' + A EUOM 5A O 4 42 + A 5 2'Qty Received (vendor UOM):' + A EQTY 11Y 4B 5 30EDTCDE(3) + A 6 2'Lot Controlled:' + A ELOTCTL 1A O 6 18 + A 7 2'Lot Number:' + A ELOT 20A B 7 14 + A 7 36'(required if lot controlled)' + A 8 2'Notes:' + A ENOTES 50A B 8 9 + A 23 2'Enter=Save F12=Cancel' + A COLOR(BLU) + A R RMSGSFL SFL + A SFLMSGRCD(24) + A SMSGKEY SFLMSGKEY + A SPGMQ SFLPGMQ(10) + A R RMSGCTL SFLCTL(RMSGSFL) + A OVERLAY + A N41 40 SFLDSP + A 41 SFLCLR + A N41 40 SFLEND + A SFLSIZ(0002) + A SFLPAG(0001) diff --git a/perp/qddssrc/reqaprd.dspf b/perp/qddssrc/reqaprd.dspf new file mode 100644 index 00000000..120832ba --- /dev/null +++ b/perp/qddssrc/reqaprd.dspf @@ -0,0 +1,117 @@ + A DSPSIZ(24 80 *DS3) + A PRINT + A CA03(03 'Exit') + A CA05(05 'Refresh') + A CA06(06 'Approve') + A CA07(07 'Reject') + A CA12(12 'Cancel') + A R ASFL SFL + A 51 SFLNXTCHG + A ASOPT 1A B 9 2 + A 50 DSPATR(RI) + A 50 DSPATR(PC) + A ASREQNBR 8A O 9 5 + A ASREQBY 10A O 9 14 + A ASNEEDBY L O 9 25DATFMT(*MDY) + A ASPRICD 10A O 9 36 + A ASTOTEST 15Y 2O 9 47EDTCDE(3) + A ASCONF 8A O 9 65 + A R ASCTL SFLCTL(ASFL) + A SFLSIZ(0099) + A SFLPAG(0007) + A OVERLAY + A SFLDSPCTL + A N31 30 SFLDSP + A 31 SFLCLR + A N31 30 SFLEND(*MORE) + A 1 24'Requisitions Awaiting Approval' + A DSPATR(HI) + A 2 2'Company:' + A LCOMPDSP 3A O 2 11 + A 6 2'Type option 5=Review, press Enter.' + A 8 2'Opt' + A DSPATR(UL) + A 8 6'Req #' + A DSPATR(UL) + A 8 14'Requested By' + A DSPATR(UL) + A 8 27'Need By' + A DSPATR(UL) + A 8 36'Priority' + A DSPATR(UL) + A 8 47'Est Cost' + A DSPATR(UL) + A 8 65'Confid.' + A DSPATR(UL) + A R RLFOOT + A OVERLAY + A 23 2'F3=Exit F5=Refresh F12=Cancel' + A COLOR(BLU) + A R RNOSUB + A OVERLAY + A 11 24'No requisitions to review.' + A R RDETAIL + A OVERLAY + A 1 28'Requisition Detail' + A DSPATR(HI) + A 2 2'Req #:' + A DDREQNBR 8A O 2 9 + A 2 30'Requested By:' + A DDREQBY 10A O 2 44 + A 3 2'Need By:' + A DDNEEDBY L O 3 11DATFMT(*MDY) + A 3 30'Priority:' + A DDPRICD 20A O 3 40 + A 4 2'Total Est Cost:' + A DDTOTEST 15Y 2O 4 18EDTCDE(3) + A 4 40'Confidence:' + A DDCONF 10A O 4 52 + A 6 2'Lines:' + A 7 2'Item' + A DSPATR(UL) + A 7 29'Qty' + A DSPATR(UL) + A 7 47'UOM' + A DSPATR(UL) + A 7 54'Cost' + A DSPATR(UL) + A 60 L1ITEM 25A O 8 2 + A 60 L1QTY 15Y 4O 8 29EDTCDE(3) + A 60 L1UOM 5A O 8 47 + A 60 L1COST 15Y 4O 8 54EDTCDE(3) + A 61 L2ITEM 25A O 9 2 + A 61 L2QTY 15Y 4O 9 29EDTCDE(3) + A 61 L2UOM 5A O 9 47 + A 61 L2COST 15Y 4O 9 54EDTCDE(3) + A 62 L3ITEM 25A O 10 2 + A 62 L3QTY 15Y 4O 10 29EDTCDE(3) + A 62 L3UOM 5A O 10 47 + A 62 L3COST 15Y 4O 10 54EDTCDE(3) + A 63 L4ITEM 25A O 11 2 + A 63 L4QTY 15Y 4O 11 29EDTCDE(3) + A 63 L4UOM 5A O 11 47 + A 63 L4COST 15Y 4O 11 54EDTCDE(3) + A 64 L5ITEM 25A O 12 2 + A 64 L5QTY 15Y 4O 12 29EDTCDE(3) + A 64 L5UOM 5A O 12 47 + A 64 L5COST 15Y 4O 12 54EDTCDE(3) + A 65 L6ITEM 25A O 13 2 + A 65 L6QTY 15Y 4O 13 29EDTCDE(3) + A 65 L6UOM 5A O 13 47 + A 65 L6COST 15Y 4O 13 54EDTCDE(3) + A 34 15 2'More lines exist -- not all shown.' + A 17 2'Approval Notes:' + A ENOTES2 50A B 17 18 + A 23 2'F6=Approve F7=Reject F12=Back' + A COLOR(BLU) + A R RMSGSFL SFL + A SFLMSGRCD(24) + A SMSGKEY SFLMSGKEY + A SPGMQ SFLPGMQ(10) + A R RMSGCTL SFLCTL(RMSGSFL) + A OVERLAY + A N41 40 SFLDSP + A 41 SFLCLR + A N41 40 SFLEND + A SFLSIZ(0002) + A SFLPAG(0001) diff --git a/perp/qddssrc/reqentd.dspf b/perp/qddssrc/reqentd.dspf new file mode 100644 index 00000000..28666d98 --- /dev/null +++ b/perp/qddssrc/reqentd.dspf @@ -0,0 +1,109 @@ + A DSPSIZ(24 80 *DS3) + A PRINT + A CA03(03 'Exit') + A CA05(05 'Refresh') + A CA06(06 'Add') + A CA08(08 'Submit') + A CA12(12 'Cancel') + A R RHEAD + A OVERLAY + A 1 30'Requisition Entry' + A DSPATR(HI) + A 2 2'Company:' + A HCOMPDSP 3A O 2 11 + A 3 2'Requested By:' + A HREQBY 10A B 3 16 + A 4 2'Need By Date:' + A HNEEDBY L B 4 16DATFMT(*MDY) + A 4 28'(MM/DD/YY)' + A 5 2'Priority:' + A HPRICD 20A B 5 12 + A 5 34'(LOW/NORMAL/HIGH/CRITICAL)' + A 6 2'Notes:' + A HNOTES 50A B 6 9 + A 23 2'F3=Exit F12=Cancel' + A COLOR(BLU) + A R RLSFL SFL + A 51 SFLNXTCHG + A SLOPT 1A B 9 2 + A 50 DSPATR(RI) + A 50 DSPATR(PC) + A SLLINE 3Y 0O 9 5 + A SLITEM 25A O 9 10 + A SLQTY 15Y 4O 9 36EDTCDE(3) + A SLUOM 5A O 9 54 + A SLCOST 15Y 4O 9 61EDTCDE(3) + A R RLCTL SFLCTL(RLSFL) + A SFLSIZ(0099) + A SFLPAG(0007) + A OVERLAY + A SFLDSPCTL + A N31 30 SFLDSP + A 31 SFLCLR + A N31 30 SFLEND(*MORE) + A 1 30'Requisition Lines' + A DSPATR(HI) + A 2 2'Req #:' + A DREQNBR 15A O 2 9 + A 2 40'Requested By:' + A DREQBY 10A O 2 54 + A 3 2'Need By:' + A DNEEDBY L O 3 11DATFMT(*MDY) + A 3 40'Priority:' + A DPRICD 20A O 3 50 + A 4 2'Status:' + A DSTATUS 20A O 4 10 + A 4 40'Total Est Cost:' + A DTOTEST 15Y 2O 4 56EDTCDE(3) + A 6 2'Type option, press Enter.' + A 7 4'2=Change 4=Delete' + A 8 2'Opt' + A DSPATR(UL) + A 8 6'Line' + A DSPATR(UL) + A 8 11'Item' + A DSPATR(UL) + A 8 36'Qty' + A DSPATR(UL) + A 8 54'UOM' + A DSPATR(UL) + A 8 61'Cost' + A DSPATR(UL) + A R RLFOOT + A OVERLAY + A 23 2'F3=Exit F5=Refresh F6=Add F8=Su- + A bmit F12=Cancel' + A COLOR(BLU) + A R RNOLIN + A OVERLAY + A 11 20'No lines yet. Press F6=Add.' + A R RLEDIT + A OVERLAY + A 1 25'Add/Change Requisition Line' + A DSPATR(HI) + A 2 2'Mode:' + A EMODE 1A O 2 8 + A 3 2'Item Number:' + A EITEM 25A B 3 15 + A 3 41'(? = prompt)' + A 4 2'Quantity:' + A EQTY 15Y 4B 4 12EDTCDE(3) + A 5 2'UOM:' + A EUOM 5A B 5 7 + A 5 15'(blank = default from item)' + A 6 2'Est Unit Cost:' + A ECOST 15Y 4B 6 17EDTCDE(3) + A 6 34'(0 = default from vendor)' + A 23 2'Enter=Save F12=Cancel' + A COLOR(BLU) + A R RMSGSFL SFL + A SFLMSGRCD(24) + A SMSGKEY SFLMSGKEY + A SPGMQ SFLPGMQ(10) + A R RMSGCTL SFLCTL(RMSGSFL) + A OVERLAY + A N41 40 SFLDSP + A 41 SFLCLR + A N41 40 SFLEND + A SFLSIZ(0002) + A SFLPAG(0001) diff --git a/perp/qddssrc/vndprmtd.dspf b/perp/qddssrc/vndprmtd.dspf new file mode 100644 index 00000000..bac1c25a --- /dev/null +++ b/perp/qddssrc/vndprmtd.dspf @@ -0,0 +1,52 @@ + A DSPSIZ(24 80 *DS3) + A PRINT + A CA03(03 'Exit') + A CA05(05 'Refresh') + A CA12(12 'Cancel') + A R VPSFL SFL + A 51 SFLNXTCHG + A SOPT 1A B 8 2 + A 50 DSPATR(RI) + A 50 DSPATR(PC) + A SIVENDOR 10A O 8 5 + A SIVNAME 60A O 8 17 + A R VPCTL SFLCTL(VPSFL) + A SFLSIZ(0099) + A SFLPAG(0007) + A OVERLAY + A SFLDSPCTL + A N31 30 SFLDSP + A 31 SFLCLR + A N31 30 SFLEND(*MORE) + A 1 30'Vendor Number Prompt' + A DSPATR(HI) + A 2 2'Search (vendor # or name):' + A SSEARCH 30A B 2 30 + A 4 2'Type 1 to select a vendor, o- + A r change Search and press En- + A ter.' + A 7 2'Opt' + A DSPATR(UL) + A 7 6'Vendor' + A DSPATR(UL) + A 7 17'Name' + A DSPATR(UL) + A R VPFOOT + A 23 2'F3=Exit F5=Refresh F12=Ca- + A ncel' + A COLOR(BLU) + A R VPNONE + A OVERLAY + A 10 20'** No vendors match this sea- + A rch **' + A R VPMSGSFL SFL + A SFLMSGRCD(24) + A SMSGKEY SFLMSGKEY + A SPGMQ SFLPGMQ(10) + A R VPMSGCTL SFLCTL(VPMSGSFL) + A OVERLAY + A N41 40 SFLDSP + A 41 SFLCLR + A N41 40 SFLEND + A SFLSIZ(0002) + A SFLPAG(0001) diff --git a/perp/qddssrc/wlmd.dspf b/perp/qddssrc/wlmd.dspf new file mode 100644 index 00000000..2bee653e --- /dev/null +++ b/perp/qddssrc/wlmd.dspf @@ -0,0 +1,55 @@ + A DSPSIZ(24 80 *DS3) + A PRINT + A CA03(03 'Exit') + A CA05(05 'Refresh') + A CA06(06 'Add') + A CA12(12 'Cancel') + A R WLEDIT + A OVERLAY + A 1 22'Warehouse Layout Maintenance' + A DSPATR(HI) + A 2 2'Company . . . . . . . :' + A ECOMPC 3A O 2 27 + A 3 2'Status . . . . . . . . :' + A ESTAT 10A O 3 27 + A 5 2'Warehouse name . . . . :' + A EWHSNM 50A B 5 28 + A 7 2'Grid dimensions' + A DSPATR(UL) + A 8 2'Aisles . . . . . . . . :' + A EASLCNT 5Y 0B 8 28EDTCDE(3) + A 9 2'Bays per aisle . . . . :' + A EBAYSPA 5Y 0B 9 28EDTCDE(3) + A 10 2'Shelves per bay . . . . :' + A ESHLFSB 5Y 0B 10 28EDTCDE(3) + A 12 2'Bin dimensions (meters)' + A DSPATR(UL) + A 13 2'Bin width . . . . . . . :' + A EBINWID 9Y 4B 13 28EDTCDE(3) + A 14 2'Bin depth . . . . . . . :' + A EBINDEP 9Y 4B 14 28EDTCDE(3) + A 15 2'Bin height . . . . . . :' + A EBINHGT 9Y 4B 15 28EDTCDE(3) + A 16 2'Aisle spacing . . . . . :' + A EASLSPC 9Y 4B 16 28EDTCDE(3) + A 18 2'Notes . . . . . . . . . :' + A ENOTES 50A B 18 28 + A R WLNOCO + A OVERLAY + A 20 20'** No company selected - run - + A Select Company first **' + A R WLFOOT + A 23 2'F3=Exit F5=Refresh F6=Add- + A F12=Cancel' + A COLOR(BLU) + A R WLMSGSFL SFL + A SFLMSGRCD(24) + A SMSGKEY SFLMSGKEY + A SPGMQ SFLPGMQ(10) + A R WLMSGCTL SFLCTL(WLMSGSFL) + A OVERLAY + A N41 40 SFLDSP + A 41 SFLCLR + A N41 40 SFLEND + A SFLSIZ(0002) + A SFLPAG(0001) diff --git a/perp/qddssrc/wrkcmd.dspf b/perp/qddssrc/wrkcmd.dspf new file mode 100644 index 00000000..ac642879 --- /dev/null +++ b/perp/qddssrc/wrkcmd.dspf @@ -0,0 +1,76 @@ + A DSPSIZ(24 80 *DS3) + A PRINT + A CA03(03 'Exit') + A CA05(05 'Refresh') + A CA06(06 'Add') + A CA12(12 'Cancel') + A R CMSFL SFL + A 51 SFLNXTCHG + A SOPT 1A B 8 4 + A 50 DSPATR(RI) + A 50 DSPATR(PC) + A STYPE 20A O 8 9 + A SVALUE 20A O 8 31 + A SDESC 30A O 8 53 + A R CMCTL SFLCTL(CMSFL) + A SFLSIZ(0099) + A SFLPAG(0007) + A OVERLAY + A SFLDSPCTL + A N31 30 SFLDSP + A 31 SFLCLR + A N31 30 SFLEND(*MORE) + A 1 30'Work with System Codes' + A DSPATR(HI) + A 2 2'Filter type . . :' + A SFTYPE 20A B 2 20DSPATR(HI) + A 4 2'Type option, press Enter.' + A 5 4'2=Change 4=Delete 5=Displ- + A ay' + A 7 4'Opt' + A DSPATR(UL) + A 7 9'Type' + A DSPATR(UL) + A 7 31'Value' + A DSPATR(UL) + A 7 53'Description' + A DSPATR(UL) + A R CMFOOT + A 23 2'F3=Exit F5=Refresh F6=Add- + A F12=Cancel' + A COLOR(BLU) + A R CMNONE + A OVERLAY + A 10 20'** No code entries match the - + A filter **' + A R CMEDIT + A OVERLAY + A 1 30'Edit Code' + A DSPATR(HI) + A 2 2'Mode:' + A EMODE 1A O 2 8 + A 3 2'Type:' + A ETYPE 20A B 3 10 + A 4 2'Value:' + A EVALUE 20A B 4 10 + A 5 2'Description:' + A EDESC 60A B 5 15 + A 6 2'Short:' + A ESHORT 20A B 6 15 + A 7 2'Sort:' + A ESORT 6Y 0B 7 15EDTCDE(3) + A 8 2'Active:' + A EACTIVE 1A B 8 15 + A 23 2'Enter=Save F12=Cancel' + A COLOR(BLU) + A R CMMSGSFL SFL + A SFLMSGRCD(24) + A SMSGKEY SFLMSGKEY + A SPGMQ SFLPGMQ(10) + A R CMMSGCTL SFLCTL(CMMSGSFL) + A OVERLAY + A N41 40 SFLDSP + A 41 SFLCLR + A N41 40 SFLEND + A SFLSIZ(0002) + A SFLPAG(0001) diff --git a/perp/qddssrc/wrkcnvd.dspf b/perp/qddssrc/wrkcnvd.dspf new file mode 100644 index 00000000..3ac43249 --- /dev/null +++ b/perp/qddssrc/wrkcnvd.dspf @@ -0,0 +1,78 @@ + A DSPSIZ(24 80 *DS3) + A PRINT + A CA03(03 'Exit') + A CA05(05 'Refresh') + A CA06(06 'Add') + A CA12(12 'Cancel') + A R CVSFL SFL + A 51 SFLNXTCHG + A SOPT 1A B 8 2 + A 50 DSPATR(RI) + A 50 DSPATR(PC) + A SFROM 5A O 8 6 + A STO 5A O 8 12 + A SFACT 15Y 6O 8 18EDTCDE(3) + A R CVCTL SFLCTL(CVSFL) + A SFLSIZ(0099) + A SFLPAG(0007) + A OVERLAY + A SFLDSPCTL + A N31 30 SFLDSP + A 31 SFLCLR + A N31 30 SFLEND(*MORE) + A 1 20'Work with Item UOM Conversions' + A DSPATR(HI) + A 2 2'Company:' + A SCOMPDSP 3A O 2 11 + A 2 20'Item Number:' + A SFITEM 25A B 2 33 + A 2 59'(? = prompt)' + A 4 2'Type option, press Enter.' + A 5 4'2=Change 4=Delete' + A 7 2'Opt' + A DSPATR(UL) + A 7 6'From' + A DSPATR(UL) + A 7 12'To' + A DSPATR(UL) + A 7 27'Factor' + A DSPATR(UL) + A R CVFOOT + A 23 2'F3=Exit F5=Refresh F6=Add- + A F12=Cancel' + A COLOR(BLU) + A R CVNONE + A OVERLAY + A 10 20'** No conversions for this it- + A em **' + A R CVNOITEM + A OVERLAY + A 10 20'** Enter an item number to be- + A gin **' + A R CVEDIT + A OVERLAY + A 1 25'Edit Item UOM Conversion' + A DSPATR(HI) + A 2 2'Mode:' + A EMODE 1A O 2 8 + A 3 2'From UOM:' + A EFROM 5A B 3 13 + A 4 2'To UOM:' + A ETO 5A B 4 13 + A 5 2'Factor:' + A EFACT 15Y 6B 5 13EDTCDE(3) + A 6 2'Active:' + A EACTIVE 1A B 6 13 + A 23 2'Enter=Save F12=Cancel' + A COLOR(BLU) + A R CVMSGSFL SFL + A SFLMSGRCD(24) + A SMSGKEY SFLMSGKEY + A SPGMQ SFLPGMQ(10) + A R CVMSGCTL SFLCTL(CVMSGSFL) + A OVERLAY + A N41 40 SFLDSP + A 41 SFLCLR + A N41 40 SFLEND + A SFLSIZ(0002) + A SFLPAG(0001) diff --git a/perp/qddssrc/wrkicld.dspf b/perp/qddssrc/wrkicld.dspf new file mode 100644 index 00000000..6ac3409e --- /dev/null +++ b/perp/qddssrc/wrkicld.dspf @@ -0,0 +1,71 @@ + A DSPSIZ(24 80 *DS3) + A PRINT + A CA03(03 'Exit') + A CA05(05 'Refresh') + A CA06(06 'Add') + A CA12(12 'Cancel') + A R ICSFL SFL + A 51 SFLNXTCHG + A SOPT 1A B 8 2 + A 50 DSPATR(RI) + A 50 DSPATR(PC) + A SCLASS 10A O 8 5 + A SDESC 40A O 8 17 + A R ICCTL SFLCTL(ICSFL) + A SFLSIZ(0099) + A SFLPAG(0007) + A OVERLAY + A SFLDSPCTL + A N31 30 SFLDSP + A 31 SFLCLR + A N31 30 SFLEND(*MORE) + A 1 27'Work with Item Classes' + A DSPATR(HI) + A 2 2'Company:' + A SCOMPDSP 3A O 2 11 + A 4 2'Type option, press Enter.' + A 5 4'2=Change 4=Delete 5=Displ- + A ay' + A 7 2'Opt' + A DSPATR(UL) + A 7 6'Class' + A DSPATR(UL) + A 7 17'Description' + A DSPATR(UL) + A R ICFOOT + A 23 2'F3=Exit F5=Refresh F6=Add- + A F12=Cancel' + A COLOR(BLU) + A R ICNONE + A OVERLAY + A 10 20'** No item classes for this c- + A ompany **' + A R ICNOCO + A OVERLAY + A 10 20'** No company selected - run - + A Select Company first **' + A R ICEDIT + A OVERLAY + A 1 30'Edit Item Class' + A DSPATR(HI) + A 2 2'Mode:' + A EMODE 1A O 2 8 + A 3 2'Class:' + A ECLASS 10A B 3 10 + A 4 2'Description:' + A EDESC 60A B 4 15 + A 5 2'Active:' + A EACTIVE 1A B 5 15 + A 23 2'Enter=Save F12=Cancel' + A COLOR(BLU) + A R ICMSGSFL SFL + A SFLMSGRCD(24) + A SMSGKEY SFLMSGKEY + A SPGMQ SFLPGMQ(10) + A R ICMSGCTL SFLCTL(ICMSGSFL) + A OVERLAY + A N41 40 SFLDSP + A 41 SFLCLR + A N41 40 SFLEND + A SFLSIZ(0002) + A SFLPAG(0001) diff --git a/perp/qddssrc/wrkitmd.dspf b/perp/qddssrc/wrkitmd.dspf new file mode 100644 index 00000000..e50842a1 --- /dev/null +++ b/perp/qddssrc/wrkitmd.dspf @@ -0,0 +1,131 @@ + A DSPSIZ(24 80 *DS3) + A PRINT + A CA03(03 'Exit') + A CA05(05 'Refresh') + A CA06(06 'Add') + A CA12(12 'Cancel') + A R WISFL SFL + A 51 SFLNXTCHG + A SOPT 1A B 8 2 + A 50 DSPATR(RI) + A 50 DSPATR(PC) + A SIITEM 25A O 8 5 + A SIDESC 30A O 8 31 + A SICLASS 10A O 8 62 + A SILOT 1A O 8 73 + A SILOW 1A O 8 75 + A R WICTL SFLCTL(WISFL) + A SFLSIZ(0099) + A SFLPAG(0007) + A OVERLAY + A SFLDSPCTL + A N31 30 SFLDSP + A 31 SFLCLR + A N31 30 SFLEND(*MORE) + A 1 32'Work with Items' + A DSPATR(HI) + A 2 2'Company:' + A SCOMPDSP 3A O 2 11 + A 2 16'Class:' + A SFCLASS 10A B 2 23 + A 2 36'Active only (Y/N):' + A SFACT 1A B 2 55 + A 3 2'Low stock only (Y/N):' + A SFLOW 1A B 3 24 + A 4 2'Position To / Filter:' + A SPOSTO 30A B 4 24 + A 5 2'Type option, press Enter.' + A 6 4'2=Change 4=Delete 5=Display - + A 6=UOM Conversions 7=Lots' + A 7 2'Opt' + A DSPATR(UL) + A 7 6'Item' + A DSPATR(UL) + A 7 31'Description' + A DSPATR(UL) + A 7 62'Class' + A DSPATR(UL) + A 7 73'Lot' + A DSPATR(UL) + A 7 77'Low' + A DSPATR(UL) + A R WIFOOT + A 23 2'F3=Exit F5=Refresh F6=Add - + A F12=Cancel' + A COLOR(BLU) + A R WINONE + A OVERLAY + A 11 20'** No items match this filte- + A r **' + A R WINOCO + A OVERLAY + A 11 20'** No company selected - run- + A Select Company first **' + A R WIEDIT + A OVERLAY + A 1 30'Edit Item' + A DSPATR(HI) + A 2 2'Mode:' + A EMODE 1A O 2 8 + A 2 15'Item:' + A EITEM 25A B 2 25 + A N60 2 51'(? = prompt)' + A 3 2'Description:' + A EDESC 60A B 3 15 + A 4 2'Short Desc:' + A ESHORT 20A B 4 15 + A 5 2'Class:' + A ECLASS 10A B 5 15 + A 6 2'Inventory UOM:' + A EINVUOM 5A B 6 17 + A 6 30'Stocking UOM:' + A ESTKUOM 5A B 6 44 + A 7 2'Lot Controlled (Y/N):' + A ELOTCTL 1A B 7 24 + A 8 2'Balances (read-only -- adjus- + A ted via receipt/reconciliatio- + A n):' + A DSPATR(UL) + A 9 2'On Hand:' + A EQOH 15Y 4O 9 11EDTCDE(3) + A 9 35'Available:' + A EQAVL 15Y 4O 9 46EDTCDE(3) + A 10 2'Frozen:' + A EQFRZ 15Y 4O 10 11EDTCDE(3) + A 10 35'On Order:' + A EQOO 15Y 4O 10 46EDTCDE(3) + A 11 2'Reorder:' + A DSPATR(UL) + A 12 2'Reorder Pt:' + A ERORDPT 15Y 4B 12 14EDTCDE(3) + A 12 35'Critical:' + A ECRITLV 15Y 4B 12 46EDTCDE(3) + A 13 2'Min:' + A EMINQTY 15Y 4B 13 8EDTCDE(3) + A 13 35'Max:' + A EMAXQTY 15Y 4B 13 41EDTCDE(3) + A 14 2'Safety Stock:' + A ESAFSTK 15Y 4B 14 16EDTCDE(3) + A 14 35'Lead Time (days):' + A ELEADTM 5Y 0B 14 53EDTCDE(3) + A 15 2'Location:' + A DSPATR(UL) + A 16 2'Aisle:' + A EAISLE 10A B 16 10 + A 16 22'Bay:' + A EBAY 10A B 16 30 + A 16 44'Shelf:' + A ESHELF 10A B 16 52 + A 23 2'Enter=Save F12=Cancel' + A COLOR(BLU) + A R WIMSGSFL SFL + A SFLMSGRCD(24) + A SMSGKEY SFLMSGKEY + A SPGMQ SFLPGMQ(10) + A R WIMSGCTL SFLCTL(WIMSGSFL) + A OVERLAY + A N41 40 SFLDSP + A 41 SFLCLR + A N41 40 SFLEND + A SFLSIZ(0002) + A SFLPAG(0001) diff --git a/perp/qddssrc/wrkivnd.dspf b/perp/qddssrc/wrkivnd.dspf new file mode 100644 index 00000000..f69b5c2c --- /dev/null +++ b/perp/qddssrc/wrkivnd.dspf @@ -0,0 +1,102 @@ + A DSPSIZ(24 80 *DS3) + A PRINT + A CA03(03 'Exit') + A CA05(05 'Refresh') + A CA06(06 'Add') + A CA12(12 'Cancel') + A R IVSFL SFL + A 51 SFLNXTCHG + A SOPT 1A B 8 2 + A 50 DSPATR(RI) + A 50 DSPATR(PC) + A SIITEM 12A O 8 5 + A SIVENDOR 10A O 8 18 + A SIPARTN 12A O 8 29 + A SILEAD 5Y 0O 8 42EDTCDE(3) + A SIMOQ 9Y 4O 8 48EDTCDE(3) + A SIPACK 9Y 4O 8 59EDTCDE(3) + A SIPREF 1A O 8 70 + A R IVCTL SFLCTL(IVSFL) + A SFLSIZ(0099) + A SFLPAG(0007) + A OVERLAY + A SFLDSPCTL + A N31 30 SFLDSP + A 31 SFLCLR + A N31 30 SFLEND(*MORE) + A 1 22'Work with Item-Vendor Profiles' + A DSPATR(HI) + A 2 2'Company:' + A SCOMPDSP 3A O 2 11 + A 2 16'Item:' + A SFITEM 15A B 2 22 + A 2 39'Vendor:' + A SFVENDOR 10A B 2 47 + A 2 58'(? = prompt)' + A 4 2'Type option, press Enter.' + A 5 4'2=Change 4=Delete' + A 7 2'Opt' + A DSPATR(UL) + A 7 6'Item' + A DSPATR(UL) + A 7 18'Vendor' + A DSPATR(UL) + A 7 29'Part #' + A DSPATR(UL) + A 7 42'Lead' + A DSPATR(UL) + A 7 48'MOQ' + A DSPATR(UL) + A 7 59'Pack' + A DSPATR(UL) + A 7 70'Pref' + A DSPATR(UL) + A R IVFOOT + A 23 2'F3=Exit F5=Refresh F6=Add - + A F12=Cancel' + A COLOR(BLU) + A R IVNONE + A OVERLAY + A 10 20'** No item-vendor rows for this - + A filter **' + A R IVNOSCP + A OVERLAY + A 10 20'** Enter an item or vendor to be- + A gin **' + A R IVEDIT + A OVERLAY + A 1 25'Edit Item-Vendor Profile' + A DSPATR(HI) + A 2 2'Mode:' + A EMODE 1A O 2 8 + A 3 2'Item:' + A EITEM 25A B 3 15 + A 3 41'(? = prompt)' + A 4 2'Vendor:' + A EVENDOR 10A B 4 15 + A 4 26'(? = prompt)' + A 5 2'Vendor Part #:' + A EPARTN 25A B 5 17 + A 6 2'Lead Time (days):' + A ELEADTM 5Y 0B 6 20EDTCDE(3) + A 7 2'MOQ:' + A EMOQ 9Y 4B 7 15EDTCDE(3) + A 8 2'Pack Size:' + A EPACKSZ 9Y 4B 8 15EDTCDE(3) + A 9 2'Preferred (Y/N):' + A EPREF 1A B 9 19 + A 10 2'Active (Y/N):' + A EACTIVE 1A B 10 19 + A 23 2'Enter=Save F12=Cancel' + A COLOR(BLU) + A R IVMSGSFL SFL + A SFLMSGRCD(24) + A SMSGKEY SFLMSGKEY + A SPGMQ SFLPGMQ(10) + A R IVMSGCTL SFLCTL(IVMSGSFL) + A OVERLAY + A N41 40 SFLDSP + A 41 SFLCLR + A N41 40 SFLEND + A SFLSIZ(0002) + A SFLPAG(0001) diff --git a/perp/qddssrc/wrkivpd.dspf b/perp/qddssrc/wrkivpd.dspf new file mode 100644 index 00000000..10720726 --- /dev/null +++ b/perp/qddssrc/wrkivpd.dspf @@ -0,0 +1,81 @@ + A DSPSIZ(24 80 *DS3) + A PRINT + A CA03(03 'Exit') + A CA05(05 'Refresh') + A CA06(06 'Add New Price') + A CA12(12 'Cancel') + A R IPSFL SFL + A SEFFFRM 10A O 8 2 + A SEFFTO 10A O 8 14 + A SPRICE 11Y 4O 8 26EDTCDE(3) + A SCURR 5A O 8 40 + A SSRC 10A O 8 47 + A R IPCTL SFLCTL(IPSFL) + A SFLSIZ(0099) + A SFLPAG(0007) + A OVERLAY + A SFLDSPCTL + A N31 30 SFLDSP + A 31 SFLCLR + A N31 30 SFLEND(*MORE) + A 1 15'Item-Vendor Price History' + A DSPATR(HI) + A 2 2'Company:' + A SCOMPDSP 3A O 2 11 + A 2 16'Item:' + A SFITEM 15A B 2 22 + A 2 39'Vendor:' + A SFVENDOR 10A B 2 47 + A 2 58'(? = prompt)' + A 4 2'Historical rows are read-only. F- + A 6=Add a new current price.' + A 7 2'From' + A DSPATR(UL) + A 7 14'To' + A DSPATR(UL) + A 7 26'Price' + A DSPATR(UL) + A 7 40'Curr' + A DSPATR(UL) + A 7 47'Source' + A DSPATR(UL) + A R IPFOOT + A OVERLAY + A 23 2'F3=Exit F5=Refresh F6=Add Ne- + A w Price F12=Cancel' + A COLOR(BLU) + A R IPNONE + A OVERLAY + A 10 20'** No price history for this ite- + A m-vendor **' + A R IPNOSCP + A OVERLAY + A 10 20'** Enter an item and vendor to b- + A egin **' + A R IPADD + A OVERLAY + A 1 28'Enter New Price' + A DSPATR(HI) + A 3 2'Item:' + A EITEM 25A O 3 15 + A 4 2'Vendor:' + A EVENDOR 10A O 4 15 + A 5 2'New Unit Price:' + A ENEWPRC 11Y 4B 5 19EDTCDE(3) + A 6 2'Currency:' + A ECURR 20A B 6 19 + A 7 2'Price Source:' + A EPRCSRC 20A B 7 19 + A 23 2'Enter=Save F12=Cancel' + A COLOR(BLU) + A R IPMSGSFL SFL + A SFLMSGRCD(24) + A SMSGKEY SFLMSGKEY + A SPGMQ SFLPGMQ(10) + A R IPMSGCTL SFLCTL(IPMSGSFL) + A OVERLAY + A N41 40 SFLDSP + A 41 SFLCLR + A N41 40 SFLEND + A SFLSIZ(0002) + A SFLPAG(0001) diff --git a/perp/qddssrc/wrklotd.dspf b/perp/qddssrc/wrklotd.dspf new file mode 100644 index 00000000..0478b1ff --- /dev/null +++ b/perp/qddssrc/wrklotd.dspf @@ -0,0 +1,91 @@ + A DSPSIZ(24 80 *DS3) + A PRINT + A CA03(03 'Exit') + A CA05(05 'Refresh') + A CA06(06 'Add') + A CA12(12 'Cancel') + A R LTSFL SFL + A 51 SFLNXTCHG + A SOPT 1A B 10 2 + A 50 DSPATR(RI) + A 50 DSPATR(PC) + A SLOT 20A O 10 5 + A SQTY 15Y 4O 10 26EDTCDE(3) + A SRECV 10A O 10 44 + A SEXPD 10A O 10 56 + A R LTCTL SFLCTL(LTSFL) + A SFLSIZ(0099) + A SFLPAG(0007) + A OVERLAY + A SFLDSPCTL + A N31 30 SFLDSP + A 31 SFLCLR + A N31 30 SFLEND(*MORE) + A 1 28'Work with Item Lots' + A DSPATR(HI) + A 2 2'Company:' + A SCOMPDSP 3A O 2 11 + A 2 20'Item Number:' + A SFITEM 25A B 2 33 + A 2 59'(? = prompt)' + A 3 2'Item On Hand:' + A SIOH 15Y 4O 3 16EDTCDE(3) + A 3 38'Lot Total:' + A SLOTTOT 15Y 4O 3 51EDTCDE(3) + A 60 4 2'** DISCREPANCY -- on-hand does not- + A match lot total **' + A 60 DSPATR(HI) + A 60 COLOR(RED) + A 6 2'Type option, press Enter.' + A 7 4'2=Change 4=Delete' + A 9 2'Opt' + A DSPATR(UL) + A 9 6'Lot' + A DSPATR(UL) + A 9 26'Qty On Hand' + A DSPATR(UL) + A 9 44'Received' + A DSPATR(UL) + A 9 56'Expiry' + A DSPATR(UL) + A R LTFOOT + A 23 2'F3=Exit F5=Refresh F6=Add - + A F12=Cancel' + A COLOR(BLU) + A R LTNONE + A OVERLAY + A 12 20'** No lots for this item **' + A R LTNOITEM + A OVERLAY + A 12 20'** Enter an item number to be- + A gin **' + A R LTEDIT + A OVERLAY + A 1 28'Edit Item Lot' + A DSPATR(HI) + A 2 2'Mode:' + A EMODE 1A O 2 8 + A 3 2'Lot Number:' + A ELOT 20A B 3 14 + A 4 2'Qty On Hand:' + A EQTY 15Y 4B 4 15EDTCDE(3) + A 5 2'Received Date (MM/DD/YY):' + A ERECV 10A B 5 31 + A 6 2'Expiry Date (MM/DD/YY, bla- + A nk=none):' + A EEXPD 10A B 6 41 + A 7 2'Active:' + A EACTIVE 1A B 7 10 + A 23 2'Enter=Save F12=Cancel' + A COLOR(BLU) + A R LTMSGSFL SFL + A SFLMSGRCD(24) + A SMSGKEY SFLMSGKEY + A SPGMQ SFLPGMQ(10) + A R LTMSGCTL SFLCTL(LTMSGSFL) + A OVERLAY + A N41 40 SFLDSP + A 41 SFLCLR + A N41 40 SFLEND + A SFLSIZ(0002) + A SFLPAG(0001) diff --git a/perp/qddssrc/wrkuomd.dspf b/perp/qddssrc/wrkuomd.dspf new file mode 100644 index 00000000..c70260c7 --- /dev/null +++ b/perp/qddssrc/wrkuomd.dspf @@ -0,0 +1,70 @@ + A DSPSIZ(24 80 *DS3) + A PRINT + A CA03(03 'Exit') + A CA05(05 'Refresh') + A CA06(06 'Add') + A CA12(12 'Cancel') + A R UOSFL SFL + A 51 SFLNXTCHG + A SOPT 1A B 8 2 + A 50 DSPATR(RI) + A 50 DSPATR(PC) + A SCODE 5A O 8 5 + A SDESC 30A O 8 12 + A SCAT 20A O 8 46 + A R UOCTL SFLCTL(UOSFL) + A SFLSIZ(0099) + A SFLPAG(0007) + A OVERLAY + A SFLDSPCTL + A N31 30 SFLDSP + A 31 SFLCLR + A N31 30 SFLEND(*MORE) + A 1 30'Work with Units of Measure' + A DSPATR(HI) + A 4 2'Type option, press Enter.' + A 5 4'2=Change 4=Delete 5=Displ- + A ay' + A 7 2'Opt' + A DSPATR(UL) + A 7 5'Code' + A DSPATR(UL) + A 7 12'Description' + A DSPATR(UL) + A 7 46'Category' + A DSPATR(UL) + A R UOFOOT + A 23 2'F3=Exit F5=Refresh F6=Add- + A F12=Cancel' + A COLOR(BLU) + A R UONONE + A OVERLAY + A 10 20'** No UOM entries to display - + A **' + A R UOEDIT + A OVERLAY + A 1 30'Edit UOM' + A DSPATR(HI) + A 2 2'Mode:' + A EMODE 1A O 2 8 + A 3 2'Code:' + A ECODE 5A B 3 10 + A 4 2'Description:' + A EDESC 60A B 4 15 + A 5 2'Category:' + A ECAT 20A B 5 15 + A 6 2'Active:' + A EACTIVE 1A B 6 15 + A 23 2'Enter=Save F12=Cancel' + A COLOR(BLU) + A R UOMSGSFL SFL + A SFLMSGRCD(24) + A SMSGKEY SFLMSGKEY + A SPGMQ SFLPGMQ(10) + A R UOMSGCTL SFLCTL(UOMSGSFL) + A OVERLAY + A N41 40 SFLDSP + A 41 SFLCLR + A N41 40 SFLEND + A SFLSIZ(0002) + A SFLPAG(0001) diff --git a/perp/qddssrc/wrkusrd.dspf b/perp/qddssrc/wrkusrd.dspf new file mode 100644 index 00000000..9e428d5e --- /dev/null +++ b/perp/qddssrc/wrkusrd.dspf @@ -0,0 +1,76 @@ + A DSPSIZ(24 80 *DS3) + A PRINT + A CA03(03 'Exit') + A CA05(05 'Refresh') + A CA06(06 'Add') + A CA12(12 'Cancel') + A R USFL SFL + A 51 SFLNXTCHG + A SOPT 1A B 8 4 + A 50 DSPATR(RI) + A 50 DSPATR(PC) + A SUCODE 10A O 8 9 + A SUNAME 30A O 8 21 + A SUROLE 20A O 8 53 + A SUACT 1A O 8 75 + A R UCTL SFLCTL(USFL) + A SFLSIZ(0099) + A SFLPAG(0007) + A OVERLAY + A SFLDSPCTL + A N31 30 SFLDSP + A 31 SFLCLR + A N31 30 SFLEND(*MORE) + A 1 30'Work with PERP Users' + A DSPATR(HI) + A 4 2'Type option, press Enter.' + A 5 4'2=Change 4=Delete 5=Displ- + A ay' + A 7 4'Opt' + A DSPATR(UL) + A 7 9'User' + A DSPATR(UL) + A 7 21'Display name' + A DSPATR(UL) + A 7 53'Role' + A DSPATR(UL) + A 7 75'Act' + A DSPATR(UL) + A R UFOOT + A 23 2'F3=Exit F5=Refresh F6=Add- + A F12=Cancel' + A COLOR(BLU) + A R UNONE + A OVERLAY + A 10 20'** No users to display **' + A R UEDIT + A OVERLAY + A 1 30'Edit User' + A DSPATR(HI) + A 2 2'Mode:' + A EMODE 1A O 2 8 + A 3 2'User code:' + A EUCODE 10A B 3 15 + A 4 2'Display name:' + A EUNAME 60A B 4 17CHECK(LC) + A 5 2'Email:' + A EUEMAIL 120A B 5 15CHECK(LC) + A 7 2'Role:' + A EUROLE 20A B 7 15 + A 7 36'(ADMIN/APPROVER/BUYER/RECEIVER/REQ- + A UESTER)' + A 8 2'Active:' + A EUACT 1A B 8 15 + A 23 2'Enter=Save F12=Cancel' + A COLOR(BLU) + A R UMSGSFL SFL + A SFLMSGRCD(24) + A SMSGKEY SFLMSGKEY + A SPGMQ SFLPGMQ(10) + A R UMSGCTL SFLCTL(UMSGSFL) + A OVERLAY + A N41 40 SFLDSP + A 41 SFLCLR + A N41 40 SFLEND + A SFLSIZ(0002) + A SFLPAG(0001) diff --git a/perp/qddssrc/wrkvndd.dspf b/perp/qddssrc/wrkvndd.dspf new file mode 100644 index 00000000..4e9e6028 --- /dev/null +++ b/perp/qddssrc/wrkvndd.dspf @@ -0,0 +1,120 @@ + A DSPSIZ(24 80 *DS3) + A PRINT + A CA03(03 'Exit') + A CA05(05 'Refresh') + A CA06(06 'Add') + A CA12(12 'Cancel') + A R VSFL SFL + A 51 SFLNXTCHG + A SOPT 1A B 8 2 + A 50 DSPATR(RI) + A 50 DSPATR(PC) + A SVCODE 10A O 8 5 + A SVNAME 30A O 8 16 + A SVBUYER 10A O 8 47 + A SVACT 1A O 8 59 + A R VCTL SFLCTL(VSFL) + A SFLSIZ(0099) + A SFLPAG(0007) + A OVERLAY + A SFLDSPCTL + A N31 30 SFLDSP + A 31 SFLCLR + A N31 30 SFLEND(*MORE) + A 1 30'Work with Vendors' + A DSPATR(HI) + A 2 2'Company:' + A SCOMPDSP 3A O 2 11 + A 2 16'Active only (Y/N):' + A SFACT 1A B 2 36 + A 3 2'Buyer (blank=all):' + A SFBUYER 10A B 3 21 + A 5 2'Type option, press Enter.' + A 6 4'2=Change 4=Delete 5=Display' + A 7 2'Opt' + A DSPATR(UL) + A 7 5'Vendor' + A DSPATR(UL) + A 7 16'Name' + A DSPATR(UL) + A 7 47'Buyer' + A DSPATR(UL) + A 7 59'Act' + A DSPATR(UL) + A R VFOOT + A 23 2'F3=Exit F5=Refresh F6=Add - + A F12=Cancel' + A COLOR(BLU) + A R VNONE + A OVERLAY + A 10 20'** No vendors match this filter - + A **' + A R VNOCO + A OVERLAY + A 10 20'** No company selected - run Sel- + A ect Company first **' + A R VEDIT + A OVERLAY + A 1 30'Edit Vendor' + A DSPATR(HI) + A 2 2'Mode:' + A EMODE 1A O 2 8 + A 3 2'Vendor code:' + A EVCODE 10A B 3 15 + A 60 DSPATR(PR) + A 4 2'Name:' + A EVNAME 60A B 4 15 + A 60 DSPATR(PR) + A 5 2'Address 1:' + A EADDR1 60A B 5 15 + A 60 DSPATR(PR) + A 6 2'Address 2:' + A EADDR2 60A B 6 15 + A 60 DSPATR(PR) + A 7 2'City:' + A ECITY 30A B 7 15 + A 60 DSPATR(PR) + A 8 2'State:' + A ESTATE 3A B 8 15 + A 60 DSPATR(PR) + A 9 2'Postal Code:' + A EPOSTCD 12A B 9 15 + A 60 DSPATR(PR) + A 10 2'Country:' + A ECNTRY 3A B 10 15 + A 60 DSPATR(PR) + A 11 2'Phone:' + A EPHONE 20A B 11 15 + A 60 DSPATR(PR) + A 12 2'Email:' + A EEMAIL 60A B 12 15 + A 60 DSPATR(PR) + A 13 2'Contact Name:' + A ECNTCT 30A B 13 16 + A 60 DSPATR(PR) + A 14 2'Buyer Code:' + A EBUYER 10A B 14 15 + A 60 DSPATR(PR) + A 15 2'Payment Terms:' + A EPTERMS 20A B 15 17 + A 60 DSPATR(PR) + A 16 2'Tax ID:' + A ETAXID 20A B 16 15 + A 60 DSPATR(PR) + A 17 2'Active (Y/N):' + A EACTIVE 1A B 17 16 + A 60 DSPATR(PR) + A N60 23 2'Enter=Save F12=Cancel' + A 60 23 2'F12=Return to list' + A COLOR(BLU) + A R VMSGSFL SFL + A SFLMSGRCD(24) + A SMSGKEY SFLMSGKEY + A SPGMQ SFLPGMQ(10) + A R VMSGCTL SFLCTL(VMSGSFL) + A OVERLAY + A N41 40 SFLDSP + A 41 SFLCLR + A N41 40 SFLEND + A SFLSIZ(0002) + A SFLPAG(0001) diff --git a/perp/qrpglesrc/docseq.sqlrpgle b/perp/qrpglesrc/docseq.sqlrpgle new file mode 100644 index 00000000..ac9757ad --- /dev/null +++ b/perp/qrpglesrc/docseq.sqlrpgle @@ -0,0 +1,125 @@ +**free + +// --------------------------------------------------------------------- +// Module: docseq (document sequence service) +// Purpose: Return the next document number for a (company_code, +// document_type) pair. +// +// Strategy: UPDATE ... SET current_number = current_number+1 +// under commitment control (row-locked by DB2). If the row +// did not exist (SQLCODE=100 on the UPDATE), INSERT it at 1. +// Otherwise read current_number back into :out — the row is +// locked to this unit-of-work so no other job can bump it +// between the UPDATE and the SELECT. +// +// Callers commit/rollback the unit-of-work; this module +// never issues COMMIT / ROLLBACK. +// +// Callers: requisition, PO, and PO-receipt entry programs. +// Epic: PERP-2 (PERP-19) +// --------------------------------------------------------------------- + +ctl-opt nomain; + +// Real commitment control against PERPJRN — per DDL_STYLE_GUIDE §7. +// (Absence of SET OPTION COMMIT = *NONE is deliberate.) +exec sql set option closqlcsr = *endmod; + +/copy docseq_pr.rpgle + +// --------------------------------------------------------------------- +// Host-variable naming: the SQLRPGLE precompiler does NOT respect +// subprocedure scope when collecting host variables. Parameter names +// are unique per procedure ('nx_' vs 'pk_' prefix) to avoid the +// SQL0314 "host variable not unique" error that fires when two +// subprocedures share a parm name across the module. +// --------------------------------------------------------------------- + +// docseq_next — bump and return the next document number. +dcl-proc docseq_next export; + dcl-pi *n int(20); + nx_company char(3) const; + nx_doctype varchar(20) const; + nx_errmsg varchar(80); + end-pi; + + dcl-s nx_number int(20) inz(0); + + nx_errmsg = ''; + + // Bump — acquires row lock under commit(*chg). + exec sql + update perpdemo.document_sequence + set current_number = current_number + 1, + updated_at = current_timestamp, + updated_by = user + where company_code = :nx_company + and document_type = :nx_doctype; + + if sqlcode = 100; + // No row yet — seed at 1. + exec sql + insert into perpdemo.document_sequence + (company_code, document_type, current_number, description) + values (:nx_company, :nx_doctype, 1, :nx_doctype); + if sqlcode < 0; + nx_errmsg = 'docseq_next insert: SQLCODE=' + %char(sqlcode) + + ' SQLSTATE=' + sqlstate; + return 0; + endif; + return 1; + endif; + + if sqlcode < 0; + nx_errmsg = 'docseq_next update: SQLCODE=' + %char(sqlcode) + + ' SQLSTATE=' + sqlstate; + return 0; + endif; + + // Row was updated — read it back. + exec sql + select current_number + into :nx_number + from perpdemo.document_sequence + where company_code = :nx_company + and document_type = :nx_doctype; + if sqlcode < 0; + nx_errmsg = 'docseq_next select: SQLCODE=' + %char(sqlcode) + + ' SQLSTATE=' + sqlstate; + return 0; + endif; + + return nx_number; + +end-proc; + +// docseq_peek — read the current high-water mark WITHOUT bumping. +dcl-proc docseq_peek export; + dcl-pi *n int(20); + pk_company char(3) const; + pk_doctype varchar(20) const; + pk_errmsg varchar(80); + end-pi; + + dcl-s pk_number int(20) inz(0); + + pk_errmsg = ''; + + exec sql + select current_number + into :pk_number + from perpdemo.document_sequence + where company_code = :pk_company + and document_type = :pk_doctype; + + if sqlcode = 100; + return 0; + endif; + if sqlcode < 0; + pk_errmsg = 'docseq_peek: SQLCODE=' + %char(sqlcode) + + ' SQLSTATE=' + sqlstate; + return 0; + endif; + return pk_number; + +end-proc; diff --git a/perp/qrpglesrc/docseq_pr.rpgle b/perp/qrpglesrc/docseq_pr.rpgle new file mode 100644 index 00000000..db54a0a1 --- /dev/null +++ b/perp/qrpglesrc/docseq_pr.rpgle @@ -0,0 +1,28 @@ +**free + +// --------------------------------------------------------------------- +// Prototypes: docseq (document sequence service) +// Module: perp +// Purpose: Atomic per-company document-number allocator. +// Callers: requisition entry (REQ), PO entry (PO), +// receipt entry (RCP), any future doc-number consumer. +// Epic: PERP-2 (PERP-19) +// --------------------------------------------------------------------- + +// docseq_next — bump the (company, doc_type) high-water mark and +// return the newly-issued number. Auto-inserts the sequence row +// starting at 1 on first use. Returns 0 on error; errmsg carries +// 'SQLCODE=... SQLSTATE=...'. Callers ROLLBACK on error. +dcl-pr docseq_next int(20); + company char(3) const; + doctype varchar(20) const; + errmsg varchar(80); +end-pr; + +// docseq_peek — read the current high-water mark WITHOUT bumping. +// Returns 0 if the row doesn't exist yet. +dcl-pr docseq_peek int(20); + company char(3) const; + doctype varchar(20) const; + errmsg varchar(80); +end-pr; diff --git a/perp/qrpglesrc/docseqsmk.sqlrpgle b/perp/qrpglesrc/docseqsmk.sqlrpgle new file mode 100644 index 00000000..7326c7e3 --- /dev/null +++ b/perp/qrpglesrc/docseqsmk.sqlrpgle @@ -0,0 +1,87 @@ +**free + +// --------------------------------------------------------------------- +// Program: docseqsmk (docseq smoke test) +// Purpose: One-shot caller that exercises docseq_next / docseq_peek and +// prints the results via SNDPGMMSG so a joblog + interactive +// session confirms the service program is bound correctly. +// Meant to be CALLed once from an interactive session: +// CALL PGM(PERPDEMO/DOCSEQSMK) PARM('ACM' 'PO ') +// Also runs a peek to prove no-op reads. +// Epic: PERP-2 (PERP-19) +// --------------------------------------------------------------------- + +ctl-opt dftactgrp(*no) actgrp(*new) bnddir('PERP'); + +/copy docseq_pr.rpgle + +dcl-pr QMHSNDPM extpgm; + msgId char(7) const; + msgF char(20) const; + msgData char(256) const; + msgDataLen int(10) const; + msgType char(10) const; + stackEntry char(10) const; + stackCntr int(10) const; + msgKey char(4); + errorCode char(8) const; +end-pr; + +dcl-pi *n; + p_company char(3); + p_doctype char(3); +end-pi; + +dcl-s doctype varchar(20); +dcl-s errmsg varchar(80); +dcl-s n1 int(20); +dcl-s n2 int(20); +dcl-s peek int(20); +dcl-s line char(256); +dcl-s msgkey char(4); + +doctype = %trim(p_doctype); + +// Peek before bumping. +peek = docseq_peek(p_company : doctype : errmsg); +line = 'docseq peek before: ' + %char(peek) + ' err=' + errmsg; +callMsg(line); + +// First bump. +n1 = docseq_next(p_company : doctype : errmsg); +line = 'docseq_next #1: ' + %char(n1) + ' err=' + errmsg; +callMsg(line); + +// Second bump. +n2 = docseq_next(p_company : doctype : errmsg); +line = 'docseq_next #2: ' + %char(n2) + ' err=' + errmsg; +callMsg(line); + +// Commit so the bumps stick. +exec sql commit; + +// Peek after. +peek = docseq_peek(p_company : doctype : errmsg); +line = 'docseq peek after : ' + %char(peek) + ' err=' + errmsg; +callMsg(line); + +*inlr = *on; +return; + +dcl-proc callMsg; + dcl-pi *n; + text varchar(256) const; + end-pi; + dcl-s data char(256); + data = text; + QMHSNDPM( + 'CPF9897' : + 'QCPFMSG QSYS ' : + data : + %len(text) : + '*INFO ' : + '* ' : + 1 : + msgkey : + x'0000000000000000'); +end-proc; diff --git a/perp/qrpglesrc/itmprmt.sqlrpgle b/perp/qrpglesrc/itmprmt.sqlrpgle new file mode 100644 index 00000000..6043b0c8 --- /dev/null +++ b/perp/qrpglesrc/itmprmt.sqlrpgle @@ -0,0 +1,213 @@ +**free + +// --------------------------------------------------------------------- +// Program: itmprmt (standard, reusable Item Number prompt/lookup) +// Purpose: System-wide "?" + Enter lookup for any keyable Item Number +// field. Caller CALLs this program passing the company code +// and the field's current value; typing '?' into the field +// before Enter is the trigger convention every caller uses, +// so this program treats a '?' seed the same as a blank +// search (full list). Any other seed value pre-fills the +// Search field so partial text the user already typed keeps +// working as a filter. The subfile lists item_number + +// item_description, filtered case-insensitively on either +// column; 1=Select on a row returns that item_number in the +// same parameter. F3/F12 cancel and return the field blank. +// Model: perpselr's subfile-picker pattern (PERP-16), +// adapted for field-level invocation instead of a full-screen +// menu step. Called via a plain dynamic CALL (EXTPGM +// prototype declared in each caller) -- the same idiom +// wrkitmr already uses to call wrkcnvr/wrklotr -- not a bound +// service program, so no bnddir/exports wiring is needed. +// Callers: wrkcnvr (PERP-54), wrkitmr (PERP-57), wrkivnr (PERP-58), +// wrkivpr (PERP-59), wrklotr (PERP-60), reqentr (PERP-61), +// poentr (PERP-62). +// Epic: PERP-51 (PERP-56) +// --------------------------------------------------------------------- + +ctl-opt dftactgrp(*no) actgrp(*new); + +dcl-pi *n; + pCompcd char(3) const; + pItem varchar(25); +end-pi; + +dcl-f itmprm2d workstn sfile(itpsfl:rrn) sfile(itpmsgsfl:msgrrn); + +dcl-pr QMHSNDPM extpgm; + msgId char(7) const; + msgF char(20) const; + msgData char(256) const; + msgDataLen int(10) const; + msgType char(10) const; + stackEntry char(10) const; + stackCntr int(10) const; + msgKey char(4); + errorCode char(8) const; +end-pr; + +dcl-ds statusDS psds qualified; + programName char(10) pos(334); +end-ds; + +dcl-ds itemRow qualified; + item varchar(25); + desc varchar(60); +end-ds; + +dcl-ds rows likeds(itemRow) dim(500); +dcl-s numRows int(10); +dcl-s i int(10); +dcl-s rrn int(10); +dcl-s msgrrn int(10); +dcl-s msgkey char(4); +dcl-s selRrn int(10); +dcl-s search varchar(30); + +search = %trim(pItem); +if search = '?'; + search = ''; +endif; +ssearch = search; + +dow not *in03 and not *in12; + exsr clearMsgs; + exsr loadRows; + + if numRows = 0; + *in30 = *off; + write itpnone; + else; + exsr fillSubfile; + *in30 = *on; + endif; + + write itpfoot; + if msgrrn > 0; + *in40 = *on; + write itpmsgctl; + else; + *in40 = *off; + endif; + + exfmt itpctl; + + if *in03 or *in12; + pItem = ''; + leave; + endif; + + if *in05; + iter; + endif; + + if ssearch <> search; + search = %trim(ssearch); + iter; + endif; + + // Guard on numRows: READC against a subfile that was never written + // to this cycle (0 rows loaded) raises a "Session or device error" + // (CPF5006-class) runtime error instead of just returning *EOF. + if numRows > 0; + selRrn = 0; + readc itpsfl; + dow not %eof(itmprm2d); + if sopt = '1'; + if selRrn = 0; + selRrn = rrn; + else; + writeMsg('Only one item may be selected per Enter.'); + endif; + elseif sopt <> ''; + writeMsg('Option ' + sopt + ' is not valid - use 1.'); + endif; + readc itpsfl; + enddo; + endif; + + if selRrn > 0 and msgrrn = 0; + chain selRrn itpsfl; + pItem = siitem; + leave; + endif; + +enddo; + +*inlr = *on; +return; + +// --------------------------------------------------------------------- +begsr loadRows; + numRows = 0; + exec sql declare ip1 cursor for + select item_number, item_description + from perpdemo.item + where company_code = :pCompcd + and (:search = '' + or upper(item_number) like '%' || upper(:search) || '%' + or upper(item_description) like '%' || upper(:search) || '%') + order by item_number; + exec sql open ip1; + if sqlcode < 0; + writeMsg('SQL open failed: SQLCODE=' + %char(sqlcode)); + leavesr; + endif; + + dow numRows < %elem(rows); + exec sql fetch ip1 into :itemRow; + if sqlcode = 100 or sqlcode < 0; + leave; + endif; + numRows += 1; + rows(numRows) = itemRow; + enddo; + exec sql close ip1; +endsr; + +// --------------------------------------------------------------------- +begsr fillSubfile; + rrn = 0; + *in31 = *on; + write itpctl; + *in31 = *off; + for i = 1 to numRows; + *in50 = *off; + *in51 = *off; + sopt = ''; + siitem = rows(i).item; + sidesc = %subst(rows(i).desc : 1 : %min(%len(rows(i).desc) : 48)); + rrn += 1; + write itpsfl; + endfor; +endsr; + +// --------------------------------------------------------------------- +begsr clearMsgs; + msgrrn = 0; + *in41 = *on; + write itpmsgctl; + *in41 = *off; +endsr; + +// --------------------------------------------------------------------- +dcl-proc writeMsg; + dcl-pi *n; + text varchar(256) const; + end-pi; + dcl-s data char(256); + data = text; + QMHSNDPM( + 'CPF9897' : + 'QCPFMSG QSYS ' : + data : + %len(text) : + '*INFO ' : + '* ' : + 1 : + smsgkey : + x'0000000000000000'); + msgrrn += 1; + spgmq = statusDS.programName; + write itpmsgsfl; +end-proc; diff --git a/perp/qrpglesrc/itmvprcq.sqlrpgle b/perp/qrpglesrc/itmvprcq.sqlrpgle new file mode 100644 index 00000000..56c40402 --- /dev/null +++ b/perp/qrpglesrc/itmvprcq.sqlrpgle @@ -0,0 +1,62 @@ +**free + +// --------------------------------------------------------------------- +// Module: itmvprcq (item-vendor price history query service) +// Purpose: Implements itmvprcq_history -- see itmvprcq_pr.rpgle for the +// prototype and its docstring. +// Epic: PERP-5 (PERP-32) +// --------------------------------------------------------------------- + +ctl-opt nomain; + +// Real commitment control against PERPJRN -- per DDL_STYLE_GUIDE Sec.7. +exec sql set option closqlcsr = *endmod; + +/copy itmvprcq_pr.rpgle + +// Host-variable names prefixed hc_ -- the SQLRPGLE precompiler collects +// host variables at module scope, not subprocedure scope, so an +// unprefixed name here could collide with a future second exported +// procedure in this module (SQL0314). +dcl-proc itmvprcq_history export; + dcl-pi *n int(10); + hc_company char(3) const; + hc_item varchar(25) const; + hc_rows likeds(itmvprcq_row) dim(200); + hc_errmsg varchar(80); + end-pi; + + dcl-s hc_count int(10) inz(0); + dcl-ds hc_row likeds(itmvprcq_row); + + hc_errmsg = ''; + + exec sql declare hc1 cursor for + select vendor_code, vendor_name, + char(effective_from, iso), + case when effective_to is null then '' + else char(effective_to, iso) end, + unit_price, currency_code + from perpdemo.item_vendor_price_history + where company_code = :hc_company and item_number = :hc_item + order by effective_from; + exec sql open hc1; + if sqlcode < 0; + hc_errmsg = 'itmvprcq_history open: SQLCODE=' + %char(sqlcode) + + ' SQLSTATE=' + sqlstate; + return 0; + endif; + + dow hc_count < %elem(hc_rows); + exec sql fetch hc1 into :hc_row; + if sqlcode = 100 or sqlcode < 0; + leave; + endif; + hc_count += 1; + hc_rows(hc_count) = hc_row; + enddo; + exec sql close hc1; + + return hc_count; + +end-proc; diff --git a/perp/qrpglesrc/itmvprcq_pr.rpgle b/perp/qrpglesrc/itmvprcq_pr.rpgle new file mode 100644 index 00000000..0625cf7f --- /dev/null +++ b/perp/qrpglesrc/itmvprcq_pr.rpgle @@ -0,0 +1,37 @@ +**free + +// --------------------------------------------------------------------- +// Prototypes: itmvprcq (item-vendor price history query service) +// Module: perp +// Purpose: Effective-dated price history for one item across all of +// its vendors -- the pricing-over-time comparative graph +// demo. Callers: future graphing UI, smoke-test caller +// itmvprcqsmk. +// Epic: PERP-5 (PERP-32) +// --------------------------------------------------------------------- + +// One price-history row. ISO date strings (not native RPG date fields) +// per the PERP-3 finding: nullable DATE columns are simpler handled as +// CHAR(10) ISO strings across the embedded-SQL boundary. +dcl-ds itmvprcq_row qualified template; + vendor varchar(10); + vendorNm varchar(60); + efffrm varchar(10); + effto varchar(10); + price packed(15:4); + currency varchar(20); +end-ds; + +// itmvprcq_history -- fetch up to %elem(histRows) price-history rows for +// (company, item) across all vendors, ordered by effective_from ascending +// (oldest first, matching a left-to-right time-series graph). Returns the +// number of rows fetched (0 on error or no history; check errmsg to tell +// the two apart -- errmsg is blank when 0 legitimately means "no history +// yet"). Raises no messages itself; SQL diagnostics are returned in +// errmsg as 'SQLCODE=... SQLSTATE=...' for the caller to log/display. +dcl-pr itmvprcq_history int(10); + company char(3) const; + item varchar(25) const; + histRows likeds(itmvprcq_row) dim(200); + errmsg varchar(80); +end-pr; diff --git a/perp/qrpglesrc/ivprcqsmk.sqlrpgle b/perp/qrpglesrc/ivprcqsmk.sqlrpgle new file mode 100644 index 00000000..3970aad2 --- /dev/null +++ b/perp/qrpglesrc/ivprcqsmk.sqlrpgle @@ -0,0 +1,82 @@ +**free + +// --------------------------------------------------------------------- +// Program: ivprcqsmk (itmvprcq smoke test) +// Purpose: One-shot caller that exercises itmvprcq_history and prints +// the results via SNDPGMMSG so a joblog + interactive session +// confirms the service program is bound correctly. +// Meant to be CALLed once from an interactive session: +// CALL PGM(PERPDEMO/IVPRCQSMK) PARM('ACM' 'WIDGET1') +// Program object name is itself only 9 chars ('itmvprcqsmk' +// would be 11 -- CPD0074, IBM i object names cap at 10). +// Epic: PERP-5 (PERP-32) +// --------------------------------------------------------------------- + +ctl-opt dftactgrp(*no) actgrp(*new) bnddir('PERP'); + +/copy itmvprcq_pr.rpgle + +dcl-pr QMHSNDPM extpgm; + msgId char(7) const; + msgF char(20) const; + msgData char(256) const; + msgDataLen int(10) const; + msgType char(10) const; + stackEntry char(10) const; + stackCntr int(10) const; + msgKey char(4); + errorCode char(8) const; +end-pr; + +dcl-pi *n; + p_company char(3); + p_item char(25); +end-pi; + +dcl-ds rows likeds(itmvprcq_row) dim(200); +dcl-s item varchar(25); +dcl-s errmsg varchar(80); +dcl-s cnt int(10); +dcl-s i int(10); +dcl-s line char(256); +dcl-s msgkey char(4); +dcl-s efftoTxt varchar(10); + +item = %trim(p_item); + +cnt = itmvprcq_history(p_company : item : rows : errmsg); +line = 'itmvprcq_history rows=' + %char(cnt) + ' err=' + errmsg; +callMsg(line); + +for i = 1 to cnt; + if %trim(rows(i).effto) = ''; + efftoTxt = 'current'; + else; + efftoTxt = %trim(rows(i).effto); + endif; + line = %trim(rows(i).vendor) + ' (' + %trim(rows(i).vendorNm) + ') ' + + %trim(rows(i).efffrm) + ' to ' + efftoTxt + + ' : ' + %char(rows(i).price) + ' ' + %trim(rows(i).currency); + callMsg(line); +endfor; + +*inlr = *on; +return; + +dcl-proc callMsg; + dcl-pi *n; + text varchar(256) const; + end-pi; + dcl-s data char(256); + data = text; + QMHSNDPM( + 'CPF9897' : + 'QCPFMSG QSYS ' : + data : + %len(text) : + '*INFO ' : + '* ' : + 1 : + msgkey : + x'0000000000000000'); +end-proc; diff --git a/perp/qrpglesrc/lotrcnsmk.sqlrpgle b/perp/qrpglesrc/lotrcnsmk.sqlrpgle new file mode 100644 index 00000000..43f10e84 --- /dev/null +++ b/perp/qrpglesrc/lotrcnsmk.sqlrpgle @@ -0,0 +1,77 @@ +**free + +// --------------------------------------------------------------------- +// Program: lotrcnsmk (lotrecon smoke test) +// Purpose: One-shot caller that exercises lotrecon_run and prints the +// results via SNDPGMMSG so a joblog + interactive session +// confirms the service program is bound correctly. Also +// proves out the CoderFlow demo path: reconciled_by = +// 'CODERFLOW' when called with that parameter. +// Meant to be CALLed once from an interactive session: +// CALL PGM(PERPDEMO/LOTRCNSMK) PARM('ACM' 'CODERFLOW ') +// Epic: PERP-8 (PERP-44) +// --------------------------------------------------------------------- + +ctl-opt dftactgrp(*no) actgrp(*new) bnddir('PERP'); + +/copy lotrecon_pr.rpgle + +dcl-pr QMHSNDPM extpgm; + msgId char(7) const; + msgF char(20) const; + msgData char(256) const; + msgDataLen int(10) const; + msgType char(10) const; + stackEntry char(10) const; + stackCntr int(10) const; + msgKey char(4); + errorCode char(8) const; +end-pr; + +dcl-pi *n; + p_company char(3); + p_reconciledby char(18); +end-pi; + +dcl-ds rows likeds(lotrecon_row) dim(200); +dcl-s errmsg varchar(80); +dcl-s cnt int(10); +dcl-s i int(10); +dcl-s line char(256); +dcl-s msgkey char(4); + +cnt = lotrecon_run(p_company : p_reconciledby : rows : errmsg); +line = 'lotrecon_run discrepancies=' + %char(cnt) + ' err=' + errmsg; +callMsg(line); + +for i = 1 to cnt; + line = %trim(rows(i).item) + ' before=' + %char(rows(i).qtybefore) + + ' lotsum=' + %char(rows(i).lotsum) + + ' after=' + %char(rows(i).qtyafter); + callMsg(line); +endfor; + +// The service program never commits (leaf module rule, DDL_STYLE_GUIDE +// Sec.13) -- the caller commits here. +exec sql commit; + +*inlr = *on; +return; + +dcl-proc callMsg; + dcl-pi *n; + text varchar(256) const; + end-pi; + dcl-s data char(256); + data = text; + QMHSNDPM( + 'CPF9897' : + 'QCPFMSG QSYS ' : + data : + %len(text) : + '*INFO ' : + '* ' : + 1 : + msgkey : + x'0000000000000000'); +end-proc; diff --git a/perp/qrpglesrc/lotrecon.sqlrpgle b/perp/qrpglesrc/lotrecon.sqlrpgle new file mode 100644 index 00000000..221a99a8 --- /dev/null +++ b/perp/qrpglesrc/lotrecon.sqlrpgle @@ -0,0 +1,92 @@ +**free + +// --------------------------------------------------------------------- +// Module: lotrecon (lot vs item-balance reconciliation service) +// Purpose: Implements lotrecon_run -- see lotrecon_pr.rpgle for the +// prototype and its docstring. +// Epic: PERP-8 (PERP-44) +// --------------------------------------------------------------------- + +ctl-opt nomain; + +// Real commitment control against PERPJRN -- per DDL_STYLE_GUIDE Sec.7. +exec sql set option closqlcsr = *endmod; + +/copy lotrecon_pr.rpgle + +// Host variables prefixed lr_ -- the SQLRPGLE precompiler collects host +// variables at module scope, not subprocedure scope (DDL_STYLE_GUIDE +// Sec.13), so an unprefixed name here could collide with a future +// second exported procedure in this module. +dcl-proc lotrecon_run export; + dcl-pi *n int(10); + lr_company char(3) const; + lr_reconciledby varchar(18) const; + lr_rows likeds(lotrecon_row) dim(200); + lr_errmsg varchar(80); + end-pi; + + dcl-s lr_count int(10) inz(0); + dcl-s lr_item varchar(25); + dcl-s lr_qtyoh packed(15:4); + dcl-s lr_lotsum packed(15:4); + + lr_errmsg = ''; + + // Lot sum via a correlated subquery, not a JOIN + GROUP BY -- an + // item with zero lot rows must still be scanned (lot sum 0 vs + // whatever qty_on_hand drifted to), which an inner JOIN would drop + // and a plain GROUP BY would need a LEFT JOIN + null-handling for + // anyway. COALESCE covers the "no lot rows yet" case. + exec sql declare lr1 cursor for + select i.item_number, i.qty_on_hand, + coalesce((select sum(l.qty_on_hand) + from perpdemo.item_lot l + where l.company_code = i.company_code + and l.item_number = i.item_number + and l.is_active = 'Y'), 0) + from perpdemo.item i + where i.company_code = :lr_company + and i.lot_controlled = 'Y' + and i.is_active = 'Y' + order by i.item_number; + exec sql open lr1; + if sqlcode < 0; + lr_errmsg = 'lotrecon_run open: SQLCODE=' + %char(sqlcode) + + ' SQLSTATE=' + sqlstate; + return 0; + endif; + + dow lr_count < %elem(lr_rows); + exec sql fetch lr1 into :lr_item, :lr_qtyoh, :lr_lotsum; + if sqlcode = 100 or sqlcode < 0; + leave; + endif; + + if lr_qtyoh <> lr_lotsum; + exec sql + insert into perpdemo.reconciliation_log + (company_code, item_number, item_qty_before, lot_sum_before, + qty_after, reconciled_by, notes) + values (:lr_company, :lr_item, :lr_qtyoh, :lr_lotsum, :lr_lotsum, + :lr_reconciledby, 'Auto-repaired: lot is source of truth'); + + exec sql + update perpdemo.item + set qty_on_hand = :lr_lotsum, + updated_at = current_timestamp, + updated_by = :lr_reconciledby + where company_code = :lr_company and item_number = :lr_item; + + lr_count += 1; + lr_rows(lr_count).item = lr_item; + lr_rows(lr_count).qtybefore = lr_qtyoh; + lr_rows(lr_count).lotsum = lr_lotsum; + lr_rows(lr_count).qtyafter = lr_lotsum; + endif; + enddo; + exec sql close lr1; + + return lr_count; + +end-proc; diff --git a/perp/qrpglesrc/lotrecon_pr.rpgle b/perp/qrpglesrc/lotrecon_pr.rpgle new file mode 100644 index 00000000..7420e5f3 --- /dev/null +++ b/perp/qrpglesrc/lotrecon_pr.rpgle @@ -0,0 +1,45 @@ +**free + +// --------------------------------------------------------------------- +// Prototypes: lotrecon (lot vs item-balance reconciliation service) +// Module: perp +// Purpose: Detects drift between item.qty_on_hand and +// SUM(item_lot.qty_on_hand) for lot-controlled items +// (Option C balances -- denormalized by design, see +// item_lot.table.sql), and repairs it. Lot is the source +// of truth: item.qty_on_hand is set to match the lot sum. +// Every repair is logged to reconciliation_log. Callers: +// a future scheduled/CoderFlow job, smoke-test caller +// lotrcnsmk. +// Epic: PERP-8 (PERP-44) +// --------------------------------------------------------------------- + +// One reconciliation result row -- mirrors reconciliation_log's +// before/after columns. +dcl-ds lotrecon_row qualified template; + item varchar(25); + qtybefore packed(15:4); + lotsum packed(15:4); + qtyafter packed(15:4); +end-ds; + +// lotrecon_run -- scan every lot-controlled, active item for one +// company; for each where item.qty_on_hand <> SUM(item_lot.qty_on_hand), +// log the discrepancy to reconciliation_log and repair item.qty_on_hand +// to match the lot sum (lot is the source of truth). Returns the number +// of discrepancies found and repaired (0 = clean, no drift -- check +// errmsg to tell a genuinely clean run apart from a failed one: errmsg +// is blank when 0 legitimately means "no drift found"). +// +// Does NOT commit or rollback -- per DDL_STYLE_GUIDE.md Sec.13, leaf +// service programs never issue commitment-control statements; the +// caller commits (or rolls back on error) after this returns. +// +// Raises no messages itself; SQL diagnostics are returned in errmsg as +// 'SQLCODE=... SQLSTATE=...' for the caller to log/display. +dcl-pr lotrecon_run int(10); + company char(3) const; + reconciledby varchar(18) const; + resultRows likeds(lotrecon_row) dim(200); + errmsg varchar(80); +end-pr; diff --git a/perp/qrpglesrc/perpselr.sqlrpgle b/perp/qrpglesrc/perpselr.sqlrpgle new file mode 100644 index 00000000..3b00bf88 --- /dev/null +++ b/perp/qrpglesrc/perpselr.sqlrpgle @@ -0,0 +1,342 @@ +**free + +// --------------------------------------------------------------------- +// Program: perpselr (PERP company selection utility) +// Purpose: Interactive picker over the company table. On selection, +// persists the chosen company_code to the job's *LDA (positions +// 1-3), which every IBM i job has automatically. Downstream +// PERP programs read *LDA[1:3] to scope their queries. +// Session-local: the LDA vanishes when the job ends, exactly +// the behavior the epic asks for. +// Epic: PERP-2 (PERP-16) +// --------------------------------------------------------------------- + +ctl-opt dftactgrp(*no) actgrp(*new); + +dcl-f perpseld workstn sfile(cosfl:rrn) sfile(comsgsfl:msgrrn); + +// Local Data Area — every job has one, 1024 chars. Positions 1-3 hold +// the selected PERP company_code for downstream PERP programs. +dcl-ds ldaDS dtaara(*lda) len(1024) qualified; + compcd char(3) pos(1); +end-ds; + +dcl-pr QMHSNDPM extpgm; + msgId char(7) const; + msgF char(20) const; + msgData char(256) const; + msgDataLen int(10) const; + msgType char(10) const; + stackEntry char(10) const; + stackCntr int(10) const; + msgKey char(4); + errorCode char(8) const; +end-pr; + +dcl-ds statusDS psds qualified; + programName char(10) pos(334); +end-ds; + +dcl-ds coRow qualified; + code char(3); + name varchar(60); + curr varchar(20); +end-ds; + +dcl-ds companies likeds(coRow) dim(200); +dcl-s numCo int(10); +dcl-s i int(10); +dcl-s rrn int(10); +dcl-s msgrrn int(10); +dcl-s selRrn int(10); +dcl-s changeRrn int(10); +dcl-s selOpt char(1); +dcl-s msgkey char(4); +dcl-s holdMsg ind; +dcl-s validationFailed ind; + +in ldaDS; +scursel = ldaDS.compcd; + +dow not *in03 and not *in12; + // A message queued by an action handler below (F6=Add, 2=Change, + // 1=Select) must survive one full loop pass before being cleared, + // or it never reaches the screen -- clearMsgs wipes msgrrn back to 0 + // on the very next pass, before this pass's own exfmt ever shows it. + // holdMsg skips exactly one clearMsgs call right after such a + // message was queued. Same pattern as wrkivpr (PERP-74). + if holdMsg; + holdMsg = *off; + else; + exsr clearMsgs; + endif; + exsr loadCompanies; + + if numCo = 0; + *in30 = *off; + write conone; + else; + exsr fillSubfile; + *in30 = *on; + endif; + + write cofoot; + if msgrrn > 0; + *in40 = *on; + write comsgctl; + else; + *in40 = *off; + endif; + + exfmt coctl; + + if *in03 or *in12; + leave; + endif; + + if *in05; + iter; // refresh + endif; + + if *in06; + exsr addCompany; + iter; + endif; + + // Guard on numCo: READC against a subfile that was never written to + // this cycle (0 rows loaded) raises a "Session or device error" + // (CPF5006-class) runtime error instead of just returning *EOF. + if numCo > 0; + selRrn = 0; + changeRrn = 0; + readc cosfl; + dow not %eof(perpseld); + if sopt <> ''; + selOpt = sopt; + if selRrn > 0 or changeRrn > 0; + writeMsg('Only one option may be used per Enter.'); + elseif selOpt = '1'; + selRrn = rrn; + elseif selOpt = '2'; + changeRrn = rrn; + else; + writeMsg('Option ' + %trim(selOpt) + ' is not valid - use 1 or 2.'); + endif; + endif; + readc cosfl; + enddo; + endif; + + // 1=Select commits the LDA update and then exits the program + // straight back to the caller (the menu) -- same as F3 -- instead + // of redisplaying this list. No point queuing a confirmation message + // first: with no further EXFMT on this device, it would never be + // seen. + if selRrn > 0 and msgrrn = 0; + chain selRrn cosfl; + ldaDS.compcd = scompc; + out ldaDS; + scursel = ldaDS.compcd; + leave; + endif; + + if changeRrn > 0 and msgrrn = 0; + chain changeRrn cosfl; + exsr changeCompany; + endif; + +enddo; + +*inlr = *on; +return; + +// --------------------------------------------------------------------- +begsr loadCompanies; + numCo = 0; + exec sql declare cocsr cursor for + select company_code, company_name, base_currency + from perpdemo.company + where is_active = 'Y' + order by company_code; + exec sql open cocsr; + if sqlcode < 0; + writeMsg('SQL error opening cursor: ' + %char(sqlcode)); + leavesr; + endif; + + dow numCo < %elem(companies); + exec sql fetch cocsr into :coRow; + if sqlcode = 100 or sqlcode < 0; + leave; + endif; + numCo += 1; + companies(numCo) = coRow; + enddo; + exec sql close cocsr; +endsr; + +// --------------------------------------------------------------------- +begsr fillSubfile; + rrn = 0; + *in31 = *on; + write coctl; + *in31 = *off; + for i = 1 to numCo; + *in50 = *off; + *in51 = *off; + sopt = ''; + scompc = companies(i).code; + scompn = companies(i).name; + scurr = companies(i).curr; + rrn += 1; + write cosfl; + endfor; +endsr; + +// --------------------------------------------------------------------- +// Required-field validation for the Add/Change Company panel, done here +// in RPG instead of letting a blank required field surface as a raw +// FK/NOT-NULL violation from the database. +begsr validateCompany; + validationFailed = *off; + if %trim(ecompc) = ''; + writeMsg('Company Code is required.'); + validationFailed = *on; + elseif %trim(ecompnm) = ''; + writeMsg('Company Name is required.'); + validationFailed = *on; + elseif %trim(ebasecur) = ''; + writeMsg('Base Currency is required.'); + validationFailed = *on; + endif; +endsr; + +// --------------------------------------------------------------------- +begsr clearMsgs; + msgrrn = 0; + *in41 = *on; + write comsgctl; + *in41 = *off; +endsr; + +// --------------------------------------------------------------------- +// PERP-52: F6=Create new company. Minimal add panel over the company +// table -- required fields only, defaults matching the DDL's DEFAULTs +// (country_code='US', base_currency='USD'). *in60 off -- ECOMPC (the +// primary key) is editable while adding, protected while changing +// (see changeCompany below). +begsr addCompany; + exsr clearMsgs; + emode = 'A'; + *in60 = *off; + ecompc = ''; + ecompnm = ''; + eaddr1 = ''; + ecity = ''; + estate = ''; + epostcd = ''; + ecntry = 'US'; + ebasecur = 'USD'; + exfmt coedit; + if not *in12; + exsr validateCompany; + if validationFailed; + holdMsg = *on; + else; + exec sql + insert into perpdemo.company + (company_code, company_name, address_line1, city_name, + state_code, postal_code, country_code, base_currency) + values (:ecompc, :ecompnm, :eaddr1, :ecity, + :estate, :epostcd, :ecntry, :ebasecur); + if sqlcode < 0; + writeMsg('Add company failed: SQLCODE=' + %char(sqlcode) + + ' SQLSTATE=' + sqlstate); + else; + writeMsg('Company ' + %trim(ecompc) + ' created.'); + endif; + holdMsg = *on; + endif; + endif; + // *in12 (F12) here only cancels the Add Company panel, not the + // whole Select Company screen -- reset before returning to the + // outer dow, which also tests *in12 to decide whether to exit. + *in12 = *off; +endsr; + +// --------------------------------------------------------------------- +// PERP-52: 2=Change. Same COEDIT panel as Add, but the company code +// (primary key, referenced by FK from nearly every other PERP table) +// is protected -- *in60 on makes ECOMPC display-only via DSPATR(PR) +// in the DDS, so the WHERE clause below always matches the row the +// user actually selected, never a typo'd or retyped code. +begsr changeCompany; + exsr clearMsgs; + emode = 'C'; + *in60 = *on; + ecompc = scompc; + exec sql + select company_name, address_line1, city_name, state_code, + postal_code, country_code, base_currency + into :ecompnm, :eaddr1, :ecity, :estate, + :epostcd, :ecntry, :ebasecur + from perpdemo.company + where company_code = :ecompc; + if sqlcode <> 0; + writeMsg('Company ' + %trim(ecompc) + ' disappeared before change.'); + holdMsg = *on; + leavesr; + endif; + exfmt coedit; + if not *in12; + exsr validateCompany; + if validationFailed; + holdMsg = *on; + else; + exec sql + update perpdemo.company + set company_name = :ecompnm, + address_line1 = :eaddr1, + city_name = :ecity, + state_code = :estate, + postal_code = :epostcd, + country_code = :ecntry, + base_currency = :ebasecur, + updated_at = current_timestamp, + updated_by = user + where company_code = :ecompc; + if sqlcode < 0; + writeMsg('Change failed: SQLCODE=' + %char(sqlcode) + + ' SQLSTATE=' + sqlstate); + else; + writeMsg('Company ' + %trim(ecompc) + ' updated.'); + endif; + holdMsg = *on; + endif; + endif; + *in12 = *off; +endsr; + +// --------------------------------------------------------------------- +dcl-proc writeMsg; + dcl-pi *n; + text varchar(256) const; + end-pi; + + dcl-s data char(256); + + data = text; + QMHSNDPM( + 'CPF9897' : + 'QCPFMSG QSYS ' : + data : + %len(text) : + '*INFO ' : + '* ' : + 1 : + smsgkey : + x'0000000000000000'); + msgrrn += 1; + spgmq = statusDS.programName; + write comsgsfl; +end-proc; diff --git a/perp/qrpglesrc/pobrwr.sqlrpgle b/perp/qrpglesrc/pobrwr.sqlrpgle new file mode 100644 index 00000000..93d6284e --- /dev/null +++ b/perp/qrpglesrc/pobrwr.sqlrpgle @@ -0,0 +1,492 @@ +**free + +// --------------------------------------------------------------------- +// Program: pobrwr (PO Browse & Inquiry) +// Purpose: Filterable subfile of PO headers with drill-down to detail. +// Filters: status_code, vendor_code, buyer_code, order-date +// range. Enter reloads the subfile with the current filter +// values. +// +// Option 5 on a PO switches to plain-record BDETAIL showing +// header + up to 6 lines joined to po_line_open for open_qty +// and extended_price + a src-req display + a schedule +// summary line. Follows reqaprr's "one subfile + plain +// detail" shape (DDL_STYLE_GUIDE.md Sec.14) to avoid the +// CPF5006 two-subfile crash. +// +// Option 9 calls poschr for the selected PO (line 1) so the +// user can drill into blanket schedules without leaving the +// browse -- if the PO has no lines, that call falls through +// to the schedule program's own not-found message. +// Epic: PERP-7 (PERP-41) +// --------------------------------------------------------------------- + +// datfmt(*iso) is REQUIRED here (not decorative). FFRDT/FTODT are +// DATFMT(*MDY) on pobrwd.dspf, which binds their underlying variables +// to *MDY's 1940-2039 year range regardless of this ctl-opt (which +// only governs Date variables not tied to a display-file field) -- +// see the PERP-89 clamp below, which uses 1940-01-01/2039-12-31 as +// in-range sentinels for exactly this reason (an out-of-range sentinel +// like 0001-01-01 crashes with RNQ0114 the moment it's assigned to +// one of these fields -- confirmed live in poentr's EEXPDT). +ctl-opt dftactgrp(*no) actgrp(*new) datfmt(*iso); + +dcl-f pobrwd workstn sfile(bsfl:rrn) sfile(rmsgsfl:msgrrn); + +dcl-ds ldaDS dtaara(*lda) len(1024) qualified; + compcd char(3) pos(1); +end-ds; + +dcl-pr QMHSNDPM extpgm; + msgId char(7) const; + msgF char(20) const; + msgData char(256) const; + msgDataLen int(10) const; + msgType char(10) const; + stackEntry char(10) const; + stackCntr int(10) const; + msgKey char(4); + errorCode char(8) const; +end-pr; + +dcl-pr poschCall extpgm('POSCHR'); + in_ponbr char(10) const; + in_line packed(3:0) const; +end-pr; + +dcl-ds statusDS psds qualified; + programName char(10) pos(334); +end-ds; + +dcl-ds poRow qualified; + ponbr int(20); + vndcd char(10); + vndnm varchar(60); + buyer char(10); + orddt date; + stat varchar(20); +end-ds; + +dcl-ds rows likeds(poRow) dim(500); +dcl-s numRows int(10); +dcl-s rrn int(10); +dcl-s msgrrn int(10); +dcl-s selRrn int(10); +dcl-s i int(10); +dcl-s compcd char(3); +dcl-s selOpt char(1); +dcl-s selPo int(20); +dcl-s firstLine int(10); +dcl-s cnt int(10); +dcl-s doneAll ind; + +// Cursor scalars. +dcl-s cPo int(20); +dcl-s cVnd char(10); +dcl-s cVndNm varchar(60); +dcl-s cBuyer char(10); +dcl-s cOrdDt date; +dcl-s cStat varchar(20); +dcl-s cCurr varchar(20); +dcl-s cTot packed(15:2); +dcl-s cLine int(10); +dcl-s cItem varchar(25); +dcl-s cOrd packed(15:4); +dcl-s cRcv packed(15:4); +dcl-s cOpen packed(15:4); +dcl-s cPrice packed(15:4); +dcl-s cSrcReq int(20); +dcl-s cSrcLn int(10); +dcl-s cSchCnt int(10); + +// Locals used by showDetail/putLine -- hoisted to main scope; dcl-s +// inside a begsr triggers RNF0724 (DDL_STYLE_GUIDE.md Sec.13). +dcl-s ln int(10); +dcl-s schedTot packed(15:4); +dcl-s schedCnt int(10); +dcl-s srcTxt char(8); + +in ldaDS; +compcd = ldaDS.compcd; + +if compcd = ''; + exsr clearMsgs; + writeMsg('No company selected - run Select Company (PERPSELR) first.'); + *in40 = *on; + lcompdsp = ''; + write rmsgctl; + exfmt bfoot; + *inlr = *on; + return; +endif; + +lcompdsp = compcd; +// Initial filter state -- everything. +fstat = ''; +fvnd = ''; +fbuy = ''; +// Filter sentinels must be within the *MDY 1940-2039 range: the SQL +// precompiler generates its intermediate host variables (SQL_00020 / +// SQL_00021 for :ffrdt / :ftodt) with the JOB DATFMT (*MDY on this +// env), IGNORING the ctl-opt datfmt(*iso). Assigning any date outside +// 1940-2039 into those generated vars crashes with RNQ0114. 1940 and +// 2039 both safely bracket every realistic PO order_date. Also parse +// with :*ISO in case a future ctl-opt change drops the datfmt override. +ffrdt = %date('1940-01-01' : *ISO); +ftodt = %date('2039-12-31' : *ISO); +doneAll = *off; + +// ----------------------------------------------------------------------- +// Browse loop. +// ----------------------------------------------------------------------- +dow not doneAll; + exsr loadPOs; + + if numRows = 0; + *in30 = *off; + write bnopo; + else; + exsr fillBSFL; + *in30 = *on; + endif; + + write bfoot; + *in40 = *off; + if msgrrn > 0; + *in40 = *on; + endif; + write rmsgctl; + exfmt bsctl; + + if *in03 or *in12; + leave; + endif; + + // PERP-89: blanking (or otherwise invalidating) either date filter + // produces a value outside the *MDY-safe 1940-2039 range, which then + // crashes with RNQ0114 the moment loadPOs' embedded SQL touches it + // (the SQL precompiler's own intermediate host variable for a date + // parameter is bound to the JOB's *MDY format regardless of this + // program's ctl-opt datfmt(*iso) override -- see the header comment + // and DDL_STYLE_GUIDE.md). %subdt is a plain RPG built-in, not an + // SQL host variable, so it's safe to test the *year* of whatever + // came back from the screen -- including an out-of-range value -- + // before it ever reaches loadPOs. Clamping back to the sentinel is + // exactly "blank means no filter on that side" per the ticket. + if %subdt(ffrdt : *years) < 1940 or %subdt(ffrdt : *years) > 2039; + ffrdt = %date('1940-01-01' : *ISO); + endif; + if %subdt(ftodt : *years) < 1940 or %subdt(ftodt : *years) > 2039; + ftodt = %date('2039-12-31' : *ISO); + endif; + + exsr clearMsgs; + + // Handle selections (Opt 5 = detail, Opt 9 = schedule maintenance). + if numRows > 0; + selRrn = 0; + selOpt = ' '; + selPo = 0; + readc bsfl; + dow not %eof(pobrwd); + if bsopt <> ''; + if selRrn = 0; + selRrn = rrn; + selOpt = bsopt; + selPo = rows(rrn).ponbr; + else; + writeMsg('Only one selection per Enter.'); + endif; + endif; + readc bsfl; + enddo; + + if selRrn > 0 and msgrrn = 0; + select; + when selOpt = '5'; + exsr showDetail; + // PERP-96: F3 on the detail popup should exit the whole + // program like everywhere else, not just fall through to + // redisplaying the browse list (which is already correct + // for F12/Enter -- no change needed there). + if doneAll; + leave; + endif; + when selOpt = '9'; + // Find the first (lowest-numbered) line to hand to poschr. + exec sql + select coalesce(min(line_number), 0) + into :firstLine + from perpdemo.po_line + where company_code = :compcd + and po_number = :selPo; + if firstLine = 0; + writeMsg('PO ' + %char(selPo) + ' has no lines yet.'); + else; + poschCall(%char(selPo) : firstLine); + endif; + other; + writeMsg('Option ' + selOpt + ' not valid.'); + endsl; + endif; + endif; +enddo; + +*inlr = *on; +return; + +// --------------------------------------------------------------------- +// loadPOs -- pull PO headers matching the current filter values. +// Empty filter fields skip that filter (fstat='' means "any status", +// etc.). +// --------------------------------------------------------------------- +begsr loadPOs; + numRows = 0; + + exec sql declare bc1 cursor for + select h.po_number, h.vendor_code, v.vendor_name, h.buyer_code, + h.order_date, h.status_code + from perpdemo.po_header h + join perpdemo.vendor v + on v.company_code = h.company_code and v.vendor_code = h.vendor_code + where h.company_code = :compcd + and (:fstat = '' or h.status_code = :fstat) + and (:fvnd = '' or h.vendor_code = :fvnd) + and (:fbuy = '' or h.buyer_code = :fbuy) + and h.order_date between :ffrdt and :ftodt + order by h.po_number desc; + exec sql open bc1; + if sqlcode < 0; + writeMsg('SQL open failed: SQLCODE=' + %char(sqlcode) + + ' STATE=' + sqlstate); + leavesr; + endif; + + dow numRows < %elem(rows); + exec sql fetch bc1 into :cPo, :cVnd, :cVndNm, :cBuyer, + :cOrdDt, :cStat; + if sqlcode = 100 or sqlcode < 0; + leave; + endif; + numRows += 1; + rows(numRows).ponbr = cPo; + rows(numRows).vndcd = cVnd; + rows(numRows).vndnm = cVndNm; + rows(numRows).buyer = cBuyer; + rows(numRows).orddt = cOrdDt; + rows(numRows).stat = cStat; + enddo; + exec sql close bc1; +endsr; + +// --------------------------------------------------------------------- +begsr fillBSFL; + rrn = 0; + *in31 = *on; + write bsctl; + *in31 = *off; + for i = 1 to numRows; + bsopt = ''; + bsponbr = %char(rows(i).ponbr); + bsvndr = rows(i).vndcd; + // Direct assign VARCHAR -> fixed CHAR: RPG right-pads or truncates + // automatically. %subst is strict about the CURRENT length of a + // VARCHAR (not the declared max) and raises RNQ0100 when a value + // like 'DRAFT' (5 chars) is asked for 10 chars. + bsvndnm = rows(i).vndnm; + bsbuyer = rows(i).buyer; + bsorddt = rows(i).orddt; + bsstat = rows(i).stat; + rrn += 1; + write bsfl; + endfor; +endsr; + +// --------------------------------------------------------------------- +// showDetail -- populate BDETAIL fields for the selected PO and up +// to 6 lines from po_line_open. EXFMT once; Enter or F12 returns +// to the browse. +// --------------------------------------------------------------------- +begsr showDetail; + exec sql + select h.vendor_code, v.vendor_name, h.buyer_code, h.order_date, + h.status_code, h.total_amount, h.currency_code + into :cVnd, :cVndNm, :cBuyer, :cOrdDt, :cStat, :cTot, :cCurr + from perpdemo.po_header h + join perpdemo.vendor v + on v.company_code = h.company_code and v.vendor_code = h.vendor_code + where h.company_code = :compcd and h.po_number = :selPo; + if sqlcode <> 0; + writeMsg('PO ' + %char(selPo) + ' lookup failed: SQLCODE=' + + %char(sqlcode)); + leavesr; + endif; + + ddponbr = %char(selPo); + ddvndr = cVnd; + ddvndnm = cVndNm; + ddbuyr = cBuyer; + ddorddt = cOrdDt; + ddstat = cStat; + ddtot = cTot; + ddcurr = cCurr; + + // Turn off all line indicators. + *in60 = *off; + *in61 = *off; + *in62 = *off; + *in63 = *off; + *in64 = *off; + *in65 = *off; + *in34 = *off; + + ln = 0; + exec sql declare bc2 cursor for + select line_number, item_number, ordered_qty, received_qty, open_qty, + unit_price, + coalesce(source_requisition_number, 0), + coalesce(source_requisition_line_number, 0) + from perpdemo.po_line_open + where company_code = :compcd and po_number = :selPo + order by line_number; + exec sql open bc2; + + dow '1'; + exec sql fetch bc2 into :cLine, :cItem, :cOrd, :cRcv, :cOpen, + :cPrice, :cSrcReq, :cSrcLn; + if sqlcode = 100 or sqlcode < 0; + leave; + endif; + ln += 1; + if ln > 6; + *in34 = *on; + leave; + endif; + exsr putLine; + enddo; + exec sql close bc2; + + // Schedule summary: count + total scheduled qty across ALL lines + // of this PO. + exec sql + select count(*), coalesce(sum(scheduled_qty), 0) + into :schedCnt, :schedTot + from perpdemo.po_line_schedule + where company_code = :compcd and po_number = :selPo; + if schedCnt = 0; + ddsch = 'None'; + else; + ddsch = %char(schedCnt) + ' schedule(s), total qty ' + + %char(schedTot); + endif; + + *in40 = *off; + if msgrrn > 0; + *in40 = *on; + endif; + write rmsgctl; + exfmt bdetail; + + // PERP-96: F3 here should exit the whole program (consistent with + // every other PERP screen), not just fall through and return to the + // browse list the way F12/Enter already correctly do. + if *in03; + doneAll = *on; + endif; +endsr; + +// putLine -- ln, cItem, cOrd, cRcv, cOpen, cPrice, cSrcReq, cSrcLn +// already staged; fan out to L* fields by row. +begsr putLine; + if cSrcReq = 0; + srcTxt = ''; + else; + srcTxt = %char(cSrcReq) + '/' + %char(cSrcLn); + endif; + select; + when ln = 1; + *in60 = *on; + l1ln = cLine; + l1item = cItem; + l1ord = cOrd; + l1rcv = cRcv; + l1open = cOpen; + l1prc = cPrice; + l1src = srcTxt; + when ln = 2; + *in61 = *on; + l2ln = cLine; + l2item = cItem; + l2ord = cOrd; + l2rcv = cRcv; + l2open = cOpen; + l2prc = cPrice; + l2src = srcTxt; + when ln = 3; + *in62 = *on; + l3ln = cLine; + l3item = cItem; + l3ord = cOrd; + l3rcv = cRcv; + l3open = cOpen; + l3prc = cPrice; + l3src = srcTxt; + when ln = 4; + *in63 = *on; + l4ln = cLine; + l4item = cItem; + l4ord = cOrd; + l4rcv = cRcv; + l4open = cOpen; + l4prc = cPrice; + l4src = srcTxt; + when ln = 5; + *in64 = *on; + l5ln = cLine; + l5item = cItem; + l5ord = cOrd; + l5rcv = cRcv; + l5open = cOpen; + l5prc = cPrice; + l5src = srcTxt; + when ln = 6; + *in65 = *on; + l6ln = cLine; + l6item = cItem; + l6ord = cOrd; + l6rcv = cRcv; + l6open = cOpen; + l6prc = cPrice; + l6src = srcTxt; + endsl; +endsr; + +// --------------------------------------------------------------------- +begsr clearMsgs; + msgrrn = 0; + *in41 = *on; + write rmsgctl; + *in41 = *off; +endsr; + +// --------------------------------------------------------------------- +dcl-proc writeMsg; + dcl-pi *n; + text varchar(256) const; + end-pi; + dcl-s data char(256); + data = text; + QMHSNDPM( + 'CPF9897' : + 'QCPFMSG QSYS ' : + data : + %len(text) : + '*INFO ' : + '* ' : + 1 : + smsgkey : + x'0000000000000000'); + msgrrn += 1; + spgmq = statusDS.programName; + write rmsgsfl; +end-proc; diff --git a/perp/qrpglesrc/poentr.sqlrpgle b/perp/qrpglesrc/poentr.sqlrpgle new file mode 100644 index 00000000..a80cbfc1 --- /dev/null +++ b/perp/qrpglesrc/poentr.sqlrpgle @@ -0,0 +1,639 @@ +**free + +// --------------------------------------------------------------------- +// Program: poentr (Manual Purchase Order Entry) +// Purpose: DSPF-based manual PO entry, scoped by the company selected +// via perpselr (*LDA positions 1-3). Header screen collects +// vendor / order date / notes; buyer_code is snapshotted from +// vendor at header commit. Currency is hard-coded to USD -- +// the code_master CURRENCY lookup only has 'USD' in it today +// and there's no per-company override yet. Allocates the doc +// number via docseq_next('PO'), then inserts a DRAFT header. +// Line screen is a subfile of po_line rows -- F6=Add opens an +// edit panel that defaults UOM from item and unit_price from +// the preferred vendor's current item_vendor_price row. +// F8=Submit requires >=1 line and flips status to OPEN; +// no further changes are allowed once submitted. +// Epic: PERP-7 (PERP-38) +// --------------------------------------------------------------------- + +// eexpdt (PERP-92/PERP-78) uses 1940-01-01 as its "no expected receipt +// date" sentinel. This field is DATFMT(*MDY) on poentd.dspf (so the +// screen renders MM/DD/YY per PERP-78) -- that DDS-level format binds +// the underlying variable's valid year range to 1940-2039 REGARDLESS +// of this program's own datfmt(*iso) ctl-opt, which only governs Date +// variables NOT tied to a display-file field. An earlier attempt used +// 0001-01-01 as the sentinel and crashed with RNQ0114 the moment F6=Add +// assigned it to eexpdt -- confirmed live. 1940-01-01 is both a real, +// in-range *MDY date and obviously never a genuine business date, so +// it works as a sentinel without fighting the field's own DDS format. +ctl-opt dftactgrp(*no) actgrp(*new) bnddir('PERP') datfmt(*iso); + +dcl-f poentd workstn sfile(plsfl:rrn) sfile(pmsgsfl:msgrrn); + +/copy docseq_pr.rpgle + +dcl-ds ldaDS dtaara(*lda) len(1024) qualified; + compcd char(3) pos(1); +end-ds; + +dcl-pr QMHSNDPM extpgm; + msgId char(7) const; + msgF char(20) const; + msgData char(256) const; + msgDataLen int(10) const; + msgType char(10) const; + stackEntry char(10) const; + stackCntr int(10) const; + msgKey char(4); + errorCode char(8) const; +end-pr; + +// Standard, reusable Item/Vendor Number prompts (PERP-51/PERP-56/PERP-70). +// Same dynamic CALL idiom as wrkitmr's callWrkcnvr/callWrklotr. +dcl-pr callItmprmt extpgm('ITMPRMT'); + pCompcd char(3) const; + pItem varchar(25); +end-pr; + +dcl-pr callVndprmt extpgm('VNDPRMT'); + pCompcd char(3) const; + pVendor varchar(10); +end-pr; + +dcl-ds statusDS psds qualified; + programName char(10) pos(334); +end-ds; + +dcl-ds lineRow qualified; + lnbr int(10); + item varchar(25); + qty packed(15:4); + uom varchar(5); + price packed(15:4); +end-ds; + +dcl-ds rows likeds(lineRow) dim(500); +dcl-s numRows int(10); +dcl-s i int(10); +dcl-s rrn int(10); +dcl-s msgrrn int(10); +dcl-s selRrn int(10); +dcl-s changeRrn int(10); +dcl-s selOpt char(1); +dcl-s compcd char(3); +dcl-s ponbr int(20); +dcl-s docerrmsg varchar(80); +dcl-s poStatus varchar(20); +dcl-s nextLine int(10); +dcl-s chgLnbr int(10); +dcl-s cnt int(10); +dcl-s edefuom varchar(5); +dcl-s edefprice packed(15:4); +dcl-s edesc varchar(60); +dcl-s hbuyer char(10); +dcl-s hvname varchar(60); +dcl-s promptItem varchar(25); +dcl-s promptVendor varchar(10); +dcl-s doneAll ind; +dcl-s holdMsg ind; + +in ldaDS; +compcd = ldaDS.compcd; + +if compcd = ''; + exsr clearMsgs; + writeMsg('No company selected - run Select Company (PERPSELR) first.'); + *in40 = *on; + write pmsgctl; + hcompdsp = ''; + exfmt phead; + *inlr = *on; + return; +endif; + +hcompdsp = compcd; + +// ----------------------------------------------------------------------- +// Header entry -- collect vendor / order_date / notes, validate, +// snapshot buyer from vendor, allocate the doc number, insert the +// DRAFT header. Currency is hard-coded to USD (see program header). +// Wrapped in an outer loop (PERP-93) so a successful F8=Submit on the +// line screen below returns here for the NEXT PO instead of leaving +// the user stranded on the now-read-only submitted line list -- same +// pattern as reqentr.sqlrpgle (PERP-86). +// ----------------------------------------------------------------------- +doneAll = *off; + +dow not doneAll; + hvndcd = ''; + hvndnm = ''; + hbuycd = ''; + horddt = %date(); + hnotes = ''; + + // PERP-93: a submit confirmation queued just before restarting this + // loop must survive one pass before clearMsgs wipes it -- same + // holdMsg pattern as reqentr.sqlrpgle (PERP-86). + if holdMsg; + holdMsg = *off; + else; + exsr clearMsgs; + endif; + + dow '1'; + *in40 = *off; + if msgrrn > 0; + *in40 = *on; + endif; + write pmsgctl; + exfmt phead; + + if *in03 or *in12; + *inlr = *on; + return; + endif; + + exsr clearMsgs; + + if %trim(hvndcd) = '?'; + promptVendor = hvndcd; + callVndprmt(compcd : promptVendor); + hvndcd = promptVendor; + iter; + endif; + + if %trim(hvndcd) = ''; + writeMsg('Vendor Code is required.'); + iter; + endif; + + exec sql + select vendor_name, buyer_code + into :hvname, :hbuyer + from perpdemo.vendor + where company_code = :compcd and vendor_code = :hvndcd + and is_active = 'Y'; + if sqlcode <> 0; + writeMsg('Vendor ' + %trim(hvndcd) + ' not found for this company.'); + iter; + endif; + + hvndnm = hvname; + hbuycd = hbuyer; + + leave; + enddo; + +ponbr = docseq_next(compcd : 'PO' : docerrmsg); +if ponbr = 0; + writeMsg('Could not allocate PO number: ' + docerrmsg); + *inlr = *on; + return; +endif; + +// currency_code defaults to 'USD' via the po_header DDL default; leave +// it out of the column list so any future default change lands here +// too. +exec sql + insert into perpdemo.po_header + (company_code, po_number, vendor_code, buyer_code, order_date, + notes) + values (:compcd, :ponbr, :hvndcd, :hbuycd, :horddt, :hnotes); +if sqlcode < 0; + writeMsg('Could not create PO: SQLCODE=' + %char(sqlcode)); + *inlr = *on; + return; +endif; + +exec sql commit; + +// ----------------------------------------------------------------------- +// Line entry -- subfile of po_line rows. +// ----------------------------------------------------------------------- +exsr clearMsgs; +writeMsg('PO ' + %char(ponbr) + ' created (DRAFT) for vendor ' + + %trim(hvndcd) + '. Add lines, then F8=Submit.'); + +dow '1'; + exsr loadHeader; + exsr loadLines; + + if numRows = 0; + *in30 = *off; + write pnolin; + else; + exsr fillSubfile; + *in30 = *on; + endif; + + write plfoot; + *in40 = *off; + if msgrrn > 0; + *in40 = *on; + endif; + write pmsgctl; + exfmt plctl; + + // PERP-94: F3 exits the program; F12 must NOT -- it should just step + // back to (redisplay) this line list rather than ending the whole + // flow. The PO header is already committed at this point, so + // there's no earlier screen to unwind into. + if *in03; + doneAll = *on; + leave; + endif; + if *in12; + iter; + endif; + + exsr clearMsgs; + + if *in06; + if poStatus <> 'DRAFT'; + writeMsg('PO already submitted - no further changes allowed.'); + else; + exsr addLine; + endif; + iter; + endif; + + if *in08; + if numRows = 0; + writeMsg('At least one line is required before submitting.'); + elseif poStatus <> 'DRAFT'; + writeMsg('PO already submitted.'); + else; + exec sql + update perpdemo.po_header + set status_code = 'OPEN', + updated_at = current_timestamp, + updated_by = user + where company_code = :compcd and po_number = :ponbr; + if sqlcode < 0; + writeMsg('Submit failed: SQLCODE=' + %char(sqlcode)); + else; + exec sql commit; + // PERP-93: return to a fresh header entry screen for the next + // PO instead of staying parked on this now read-only line + // list. holdMsg carries this confirmation through to the + // restarted header loop above. + writeMsg('PO ' + %char(ponbr) + ' submitted (OPEN).'); + holdMsg = *on; + leave; + endif; + endif; + iter; + endif; + + // Drain the READC loop before switching to PLEDIT for a change + // (option 2). Same fix pattern as reqentr.sqlrpgle / DDL_STYLE_GUIDE + // Sec.14 -- collect the row to change while draining, act on it after + // the loop finishes. + if numRows > 0; + selRrn = 0; + selOpt = ' '; + changeRrn = 0; + readc plsfl; + dow not %eof(poentd); + if slopt <> ''; + selRrn = rrn; + selOpt = slopt; + exsr handleOpt; + selRrn = 0; + endif; + readc plsfl; + enddo; + + if changeRrn > 0 and msgrrn = 0; + selRrn = changeRrn; + exsr changeLine; + endif; + endif; + + enddo; +enddo; + +*inlr = *on; +return; + +// --------------------------------------------------------------------- +begsr loadHeader; + exec sql + select h.status_code, h.vendor_code, v.vendor_name, h.buyer_code, + h.order_date, h.total_amount + into :poStatus, :dvndcd, :dvndnm, :dbuycd, :dorddt, :dtotamt + from perpdemo.po_header h + join perpdemo.vendor v + on v.company_code = h.company_code and v.vendor_code = h.vendor_code + where h.company_code = :compcd and h.po_number = :ponbr; + dponbr = %char(ponbr); + dstatus = poStatus; +endsr; + +// --------------------------------------------------------------------- +begsr loadLines; + numRows = 0; + exec sql declare pc1 cursor for + select line_number, item_number, ordered_qty, uom_code, unit_price + from perpdemo.po_line + where company_code = :compcd and po_number = :ponbr + order by line_number; + exec sql open pc1; + if sqlcode < 0; + writeMsg('SQL open failed: SQLCODE=' + %char(sqlcode)); + leavesr; + endif; + + dow numRows < %elem(rows); + exec sql fetch pc1 into :lineRow.lnbr, :lineRow.item, :lineRow.qty, + :lineRow.uom, :lineRow.price; + if sqlcode = 100 or sqlcode < 0; + leave; + endif; + numRows += 1; + rows(numRows) = lineRow; + enddo; + exec sql close pc1; +endsr; + +// --------------------------------------------------------------------- +begsr fillSubfile; + rrn = 0; + *in31 = *on; + write plctl; + *in31 = *off; + for i = 1 to numRows; + slopt = ''; + slline = rows(i).lnbr; + slitem = rows(i).item; + slqty = rows(i).qty; + sluom = rows(i).uom; + slprice = rows(i).price; + rrn += 1; + write plsfl; + endfor; +endsr; + +// --------------------------------------------------------------------- +begsr handleOpt; + chain selRrn plsfl; + if %found(poentd); + if poStatus <> 'DRAFT'; + writeMsg('PO already submitted - no further changes allowed.'); + leavesr; + endif; + select; + when selOpt = '2'; + if changeRrn = 0; + changeRrn = selRrn; + else; + writeMsg('Only one line may be changed per Enter.'); + endif; + when selOpt = '4'; + exsr deleteLine; + other; + writeMsg('Option ' + selOpt + ' not valid.'); + endsl; + endif; +endsr; + +// --------------------------------------------------------------------- +begsr addLine; + emode = 'A'; + eitem = ''; + eitmdsc = ''; + eqty = 0; + euom = ''; + eprice = 0; + // Sentinel "no expected receipt date". %date() with no format uses + // the job DATFMT which on this environment is *MDY (year range + // 1940-2039), so '0001' triggers RNQ0114. Force *ISO. + eexpdt = %date('1940-01-01' : *ISO); + + dow '1'; + exfmt pledit; + if *in12; + leavesr; + endif; + + // Item Number prompt (PERP-62): '?' + Enter invokes the standard + // reusable Item Number lookup (PERP-56) and returns the selection. + if %trim(eitem) = '?'; + promptItem = eitem; + callItmprmt(compcd : promptItem); + eitem = promptItem; + iter; + endif; + + if %trim(eitem) = ''; + writeMsg('Item Number is required.'); + iter; + endif; + + exec sql + select item_description, inventory_uom + into :edesc, :edefuom + from perpdemo.item + where company_code = :compcd and item_number = :eitem; + if sqlcode <> 0; + writeMsg('Item ' + %trim(eitem) + ' not found for this company.'); + iter; + endif; + + eitmdsc = edesc; + + if eqty <= 0; + writeMsg('Quantity must be greater than zero.'); + iter; + endif; + + if %trim(euom) = ''; + euom = edefuom; + endif; + + if eprice = 0; + // Default from this vendor's current price row for the item. + exec sql + select unit_price + into :edefprice + from perpdemo.item_vendor_price + where company_code = :compcd + and item_number = :eitem + and vendor_code = :hvndcd + and effective_to is null + fetch first 1 row only; + if sqlcode = 0; + eprice = edefprice; + endif; + endif; + + leave; + enddo; + + exec sql + select coalesce(max(line_number), 0) + 1 + into :nextLine + from perpdemo.po_line + where company_code = :compcd and po_number = :ponbr; + + if eexpdt = %date('1940-01-01' : *ISO); + exec sql + insert into perpdemo.po_line + (company_code, po_number, line_number, item_number, + ordered_qty, uom_code, unit_price) + values (:compcd, :ponbr, :nextLine, :eitem, :eqty, :euom, :eprice); + else; + exec sql + insert into perpdemo.po_line + (company_code, po_number, line_number, item_number, + ordered_qty, uom_code, unit_price, expected_receipt_date) + values (:compcd, :ponbr, :nextLine, :eitem, :eqty, :euom, :eprice, + :eexpdt); + endif; + if sqlcode < 0; + writeMsg('Add line failed: SQLCODE=' + %char(sqlcode) + + ' SQLSTATE=' + sqlstate); + else; + exec sql commit; + writeMsg('Added line ' + %char(nextLine) + ': ' + %trim(edesc) + + ' (' + %trim(euom) + ' @ ' + %char(eprice) + ').'); + exsr recalcTotal; + endif; +endsr; + +// --------------------------------------------------------------------- +begsr changeLine; + chgLnbr = rows(selRrn).lnbr; + emode = 'C'; + eitem = rows(selRrn).item; + eqty = rows(selRrn).qty; + euom = rows(selRrn).uom; + eprice = rows(selRrn).price; + + exec sql + select item_description + into :edesc + from perpdemo.item + where company_code = :compcd and item_number = :eitem; + if sqlcode = 0; + eitmdsc = edesc; + else; + eitmdsc = ''; + endif; + + dow '1'; + exfmt pledit; + if *in12; + leavesr; + endif; + + // Item Number prompt (PERP-62): '?' + Enter invokes the standard + // reusable Item Number lookup (PERP-56) and returns the selection. + if %trim(eitem) = '?'; + promptItem = eitem; + callItmprmt(compcd : promptItem); + eitem = promptItem; + exec sql + select item_description + into :edesc + from perpdemo.item + where company_code = :compcd and item_number = :eitem; + if sqlcode = 0; + eitmdsc = edesc; + else; + eitmdsc = ''; + endif; + iter; + endif; + + leave; + enddo; + + if eqty <= 0; + writeMsg('Quantity must be greater than zero.'); + leavesr; + endif; + + if %trim(euom) = ''; + writeMsg('UOM is required.'); + leavesr; + endif; + + exec sql + update perpdemo.po_line + set ordered_qty = :eqty, + uom_code = :euom, + unit_price = :eprice, + updated_at = current_timestamp, + updated_by = user + where company_code = :compcd and po_number = :ponbr + and line_number = :chgLnbr; + if sqlcode < 0; + writeMsg('Change failed: SQLCODE=' + %char(sqlcode)); + else; + exec sql commit; + writeMsg('Updated line ' + %char(chgLnbr) + '.'); + exsr recalcTotal; + endif; +endsr; + +// --------------------------------------------------------------------- +begsr deleteLine; + exec sql + delete from perpdemo.po_line + where company_code = :compcd and po_number = :ponbr + and line_number = :slline; + if sqlcode < 0; + writeMsg('Delete failed: SQLSTATE=' + sqlstate); + else; + exec sql commit; + writeMsg('Deleted line ' + %char(slline) + '.'); + exsr recalcTotal; + endif; +endsr; + +// --------------------------------------------------------------------- +begsr recalcTotal; + exec sql + update perpdemo.po_header + set total_amount = + (select coalesce(sum(ordered_qty * unit_price), 0) + from perpdemo.po_line + where company_code = :compcd + and po_number = :ponbr), + updated_at = current_timestamp, + updated_by = user + where company_code = :compcd and po_number = :ponbr; + exec sql commit; +endsr; + +// --------------------------------------------------------------------- +begsr clearMsgs; + msgrrn = 0; + *in41 = *on; + write pmsgctl; + *in41 = *off; +endsr; + +// --------------------------------------------------------------------- +dcl-proc writeMsg; + dcl-pi *n; + text varchar(256) const; + end-pi; + dcl-s data char(256); + data = text; + QMHSNDPM( + 'CPF9897' : + 'QCPFMSG QSYS ' : + data : + %len(text) : + '*INFO ' : + '* ' : + 1 : + smsgkey : + x'0000000000000000'); + msgrrn += 1; + spgmq = statusDS.programName; + write pmsgsfl; +end-proc; diff --git a/perp/qrpglesrc/poprmt.sqlrpgle b/perp/qrpglesrc/poprmt.sqlrpgle new file mode 100644 index 00000000..f40c63f9 --- /dev/null +++ b/perp/qrpglesrc/poprmt.sqlrpgle @@ -0,0 +1,211 @@ +**free + +// --------------------------------------------------------------------- +// Program: poprmt (standard, reusable PO Number prompt/lookup) +// Purpose: PERP-98. Lists purchase orders still awaiting receipt +// (status_code OPEN or PARTIAL) for the calling company, +// with a Search box filtering on PO number or vendor +// code/name, case-insensitive. 1=Select on a row returns +// that po_number. F3/F12 cancel and return 0. +// po_number is a NUMERIC field (HPONBR on rcventd.dspf is +// 15Y 0), so this program does NOT use the "?" + Enter +// convention the item/vendor prompts use (a 5250 numeric +// input field rejects a literal "?" character at the device +// level, before RPG ever sees it) -- callers instead invoke +// this via a dedicated F4=Prompt key, the conventional IBM i +// UI idiom for a numeric-field lookup. +// Callers: rcventr (PERP-98). +// Epic: PERP-51 (PERP-98) +// --------------------------------------------------------------------- + +ctl-opt dftactgrp(*no) actgrp(*new); + +dcl-pi *n; + pCompcd char(3) const; + pPonbr packed(15:0); +end-pi; + +dcl-f poprmtd workstn sfile(ppsfl:rrn) sfile(ppmsgsfl:msgrrn); + +dcl-pr QMHSNDPM extpgm; + msgId char(7) const; + msgF char(20) const; + msgData char(256) const; + msgDataLen int(10) const; + msgType char(10) const; + stackEntry char(10) const; + stackCntr int(10) const; + msgKey char(4); + errorCode char(8) const; +end-pr; + +dcl-ds statusDS psds qualified; + programName char(10) pos(334); +end-ds; + +dcl-ds poRow qualified; + ponbr int(20); + vndr varchar(10); + vndnm varchar(60); + stat varchar(20); +end-ds; + +dcl-ds rows likeds(poRow) dim(500); +dcl-s numRows int(10); +dcl-s i int(10); +dcl-s rrn int(10); +dcl-s msgrrn int(10); +dcl-s msgkey char(4); +dcl-s selRrn int(10); +dcl-s search varchar(30); + +search = ''; +ssearch = search; + +dow not *in03 and not *in12; + exsr clearMsgs; + exsr loadRows; + + if numRows = 0; + *in30 = *off; + write ppnone; + else; + exsr fillSubfile; + *in30 = *on; + endif; + + write ppfoot; + if msgrrn > 0; + *in40 = *on; + write ppmsgctl; + else; + *in40 = *off; + endif; + + exfmt ppctl; + + if *in03 or *in12; + pPonbr = 0; + leave; + endif; + + if *in05; + iter; + endif; + + if %trim(ssearch) <> search; + search = %trim(ssearch); + iter; + endif; + + // Guard on numRows: READC against a subfile that was never written + // to this cycle (0 rows loaded) raises a "Session or device error" + // (CPF5006-class) runtime error instead of just returning *EOF. + if numRows > 0; + selRrn = 0; + readc ppsfl; + dow not %eof(poprmtd); + if sopt = '1'; + if selRrn = 0; + selRrn = rrn; + else; + writeMsg('Only one PO may be selected per Enter.'); + endif; + elseif sopt <> ''; + writeMsg('Option ' + sopt + ' is not valid - use 1.'); + endif; + readc ppsfl; + enddo; + endif; + + if selRrn > 0 and msgrrn = 0; + chain selRrn ppsfl; + pPonbr = siponbr; + leave; + endif; + +enddo; + +*inlr = *on; +return; + +// --------------------------------------------------------------------- +begsr loadRows; + numRows = 0; + exec sql declare pp1 cursor for + select h.po_number, h.vendor_code, v.vendor_name, h.status_code + from perpdemo.po_header h + join perpdemo.vendor v + on v.company_code = h.company_code and v.vendor_code = h.vendor_code + where h.company_code = :pCompcd + and h.status_code in ('OPEN', 'PARTIAL') + and (:search = '' + or char(h.po_number) like '%' || :search || '%' + or upper(v.vendor_code) like '%' || upper(:search) || '%' + or upper(v.vendor_name) like '%' || upper(:search) || '%') + order by h.po_number desc; + exec sql open pp1; + if sqlcode < 0; + writeMsg('SQL open failed: SQLCODE=' + %char(sqlcode)); + leavesr; + endif; + + dow numRows < %elem(rows); + exec sql fetch pp1 into :poRow; + if sqlcode = 100 or sqlcode < 0; + leave; + endif; + numRows += 1; + rows(numRows) = poRow; + enddo; + exec sql close pp1; +endsr; + +// --------------------------------------------------------------------- +begsr fillSubfile; + rrn = 0; + *in31 = *on; + write ppctl; + *in31 = *off; + for i = 1 to numRows; + *in50 = *off; + *in51 = *off; + sopt = ''; + siponbr = rows(i).ponbr; + sivndr = rows(i).vndr; + sivndnm = rows(i).vndnm; + sistat = rows(i).stat; + rrn += 1; + write ppsfl; + endfor; +endsr; + +// --------------------------------------------------------------------- +begsr clearMsgs; + msgrrn = 0; + *in41 = *on; + write ppmsgctl; + *in41 = *off; +endsr; + +// --------------------------------------------------------------------- +dcl-proc writeMsg; + dcl-pi *n; + text varchar(256) const; + end-pi; + dcl-s data char(256); + data = text; + QMHSNDPM( + 'CPF9897' : + 'QCPFMSG QSYS ' : + data : + %len(text) : + '*INFO ' : + '* ' : + 1 : + smsgkey : + x'0000000000000000'); + msgrrn += 1; + spgmq = statusDS.programName; + write ppmsgsfl; +end-proc; diff --git a/perp/qrpglesrc/poreqr.sqlrpgle b/perp/qrpglesrc/poreqr.sqlrpgle new file mode 100644 index 00000000..a9b921a9 --- /dev/null +++ b/perp/qrpglesrc/poreqr.sqlrpgle @@ -0,0 +1,626 @@ +**free + +// --------------------------------------------------------------------- +// Program: poreqr (Create POs from Approved Requisitions) +// Purpose: Convert one or more APPROVED requisitions into POs, grouping +// lines by the preferred vendor per item (one PO per vendor -> +// "splitting"), consolidating multiple selected reqs going to +// the same vendor into a single PO ("consolidation"). +// +// Line-level linkage: each generated po_line carries +// source_requisition_number + source_requisition_line_number +// so "converted" status is derivable by joining po_line back +// to requisition_line's PK (no redundant status column, per +// the PERP-37 DDL design note). +// +// Requisitions with no preferred vendor rows for their items, +// or already fully converted, are skipped with a message. +// +// Follows reqaprr's "one subfile + plain-record detail" shape +// (see DDL_STYLE_GUIDE.md Sec.14) -- SSFL (approved-req +// subfile) plus a plain SPREV record for the vendor-grouped +// preview (up to 5 vendors shown; the count message covers +// any overflow). No second real subfile. +// Epic: PERP-7 (PERP-39) +// --------------------------------------------------------------------- + +// datfmt(*iso) for consistency with the other PO programs -- the job +// DATFMT here is *MDY (2-digit year, 1940-2039) and we want every +// PERP program to accept the full RPG Date range. +ctl-opt dftactgrp(*no) actgrp(*new) bnddir('PERP') datfmt(*iso); + +dcl-f poreqd workstn sfile(ssfl:rrn) sfile(rmsgsfl:msgrrn); + +/copy docseq_pr.rpgle + +dcl-ds ldaDS dtaara(*lda) len(1024) qualified; + compcd char(3) pos(1); +end-ds; + +dcl-pr QMHSNDPM extpgm; + msgId char(7) const; + msgF char(20) const; + msgData char(256) const; + msgDataLen int(10) const; + msgType char(10) const; + stackEntry char(10) const; + stackCntr int(10) const; + msgKey char(4); + errorCode char(8) const; +end-pr; + +dcl-ds statusDS psds qualified; + programName char(10) pos(334); +end-ds; + +// A row of the approved-req subfile. +dcl-ds reqRow qualified; + reqnbr int(20); + reqby char(10); + needby date; + totest packed(15:2); + isSel ind; + // Snapshot of the dominant vendor for this req (first line's + // preferred vendor) -- purely for display. + vndcd char(10); + vndnm varchar(60); +end-ds; + +// A plan row: vendor + a list of (reqnbr, reqline, item, qty, uom, price). +dcl-ds planLine qualified; + reqnbr int(20); + reqline int(10); + item varchar(25); + qty packed(15:4); + uom varchar(5); + price packed(15:4); +end-ds; +dcl-ds vendorPlan qualified; + vndcd char(10); + vndnm varchar(60); + lineCount int(10); + totAmt packed(15:2); + lines likeds(planLine) dim(500); +end-ds; + +dcl-ds reqs likeds(reqRow) dim(500); +dcl-ds plan likeds(vendorPlan) dim(50); +dcl-s numReqs int(10); +dcl-s numPlan int(10); +dcl-s rrn int(10); +dcl-s msgrrn int(10); +dcl-s selCnt int(10); +dcl-s lineCnt int(10); +dcl-s i int(10); +dcl-s j int(10); +dcl-s k int(10); +dcl-s compcd char(3); +dcl-s docerrmsg varchar(80); +dcl-s newPo int(20); +dcl-s vidx int(10); +dcl-s prevMode ind; + +// Cursor host vars. +dcl-s cReqNbr int(20); +dcl-s cReqBy char(10); +dcl-s cNeedBy date; +dcl-s cTotEst packed(15:2); +dcl-s cVndCd char(10); +dcl-s cVndNm varchar(60); +dcl-s cReqLine int(10); +dcl-s cItem varchar(25); +dcl-s cQty packed(15:4); +dcl-s cUom varchar(5); +dcl-s cPrice packed(15:4); + +// Staging scalars for SQL statements that need array-element data. +// The SQLRPGLE precompiler does not accept :ds(i).field as a host +// variable, so we copy into these plain scalars first. +dcl-s xReqNbr int(20); +dcl-s xReqLine int(10); +dcl-s xVndCd char(10); +dcl-s xItem varchar(25); +dcl-s xQty packed(15:4); +dcl-s xUom varchar(5); +dcl-s xPrice packed(15:4); +dcl-s xTotAmt packed(15:2); +dcl-s xBuyer char(10); + +// Locals used by createPOs -- dcl-s inside a begsr triggers RNF0724 +// ("statement type out of sequence"), so they live up here. +dcl-s poCount int(10); +dcl-s lineNbr int(10); +dcl-s v int(10); +dcl-s L int(10); + +in ldaDS; +compcd = ldaDS.compcd; + +if compcd = ''; + exsr clearMsgs; + writeMsg('No company selected - run Select Company (PERPSELR) first.'); + *in40 = *on; + lcompdsp = ''; + write rmsgctl; + exfmt sfoot; + *inlr = *on; + return; +endif; + +lcompdsp = compcd; +pcompdsp = compcd; + +// ----------------------------------------------------------------------- +// Selection loop. +// ----------------------------------------------------------------------- +prevMode = *off; + +dow '1'; + exsr loadReqs; + + if numReqs = 0; + *in30 = *off; + write snosub; + else; + exsr fillSSFL; + *in30 = *on; + endif; + + write sfoot; + *in40 = *off; + if msgrrn > 0; + *in40 = *on; + endif; + write rmsgctl; + exfmt ssctl; + + if *in03 or *in12; + leave; + endif; + + exsr clearMsgs; + + // Read selections. Guard READC against an unloaded subfile + // (DDL_STYLE_GUIDE.md Sec.14 -- CPF5006 otherwise). + selCnt = 0; + if numReqs > 0; + readc ssfl; + dow not %eof(poreqd); + if ssopt = '1'; + reqs(rrn).isSel = *on; + selCnt += 1; + endif; + readc ssfl; + enddo; + endif; + + if *in06; + // *in06 is a response indicator: the workstation turns it on when + // F6 is pressed but never turns it off on its own, so it must be + // cleared here or it stays "stuck on" and every later Enter/F5/F12 + // press on this screen is misread as another F6 (PERP-97 follow-up + // bug found during live testing -- distinct from the DDS overflow). + *in06 = *off; + if selCnt = 0; + writeMsg('Select at least one requisition (option 1) before F6.'); + iter; + endif; + + exsr buildPlan; + + if numPlan = 0; + writeMsg('Selected requisitions produced no PO lines -- check that ' + + 'items have a preferred vendor with a current price row.'); + // Clear selections and iter. + for i = 1 to numReqs; + reqs(i).isSel = *off; + endfor; + iter; + endif; + + exsr showPreview; + + if *in06; + // Same stuck-indicator concern as above -- clear it once consumed. + *in06 = *off; + // Confirmed -- create the POs. + exsr createPOs; + // After creation, refresh the list (converted lines drop out + // of the "unconverted approved" query) and clear selections. + exec sql commit; + // Clear selection flags on the in-memory copy for safety. + for i = 1 to numReqs; + reqs(i).isSel = *off; + endfor; + else; + // F12 back to selection -- keep selections in the array; refill + // the subfile from reqs() so they still show. + writeMsg('Conversion cancelled.'); + // NB: subfile is rebuilt from perpdemo on next iteration, so the + // in-memory isSel flags are effectively wiped; that's fine -- + // the user re-selects. + endif; + iter; + endif; +enddo; + +*inlr = *on; +return; + +// --------------------------------------------------------------------- +// loadReqs -- pull APPROVED reqs whose lines are not yet all linked +// to a po_line. A req with SOME lines converted still shows (its +// remaining lines get placed on new POs -- classic "splitting"). +// --------------------------------------------------------------------- +begsr loadReqs; + numReqs = 0; + + exec sql declare rc1 cursor for + select h.requisition_number, h.requested_by, h.need_by_date, + h.total_estimated_cost, + coalesce(v.vendor_code, ''), + coalesce(v.vendor_name, '') + from perpdemo.requisition_header h + left join lateral ( + select iv.vendor_code, ven.vendor_name + from perpdemo.requisition_line rl + join perpdemo.item_vendor iv + on iv.company_code = rl.company_code + and iv.item_number = rl.item_number + and iv.is_preferred = 'Y' + join perpdemo.vendor ven + on ven.company_code = iv.company_code + and ven.vendor_code = iv.vendor_code + where rl.company_code = h.company_code + and rl.requisition_number = h.requisition_number + order by rl.line_number + fetch first 1 row only + ) v on 1=1 + where h.company_code = :compcd + and h.status_code = 'APPROVED' + and exists ( + select 1 + from perpdemo.requisition_line rl2 + where rl2.company_code = h.company_code + and rl2.requisition_number = h.requisition_number + and not exists ( + select 1 from perpdemo.po_line pl + where pl.company_code = rl2.company_code + and pl.source_requisition_number = rl2.requisition_number + and pl.source_requisition_line_number = rl2.line_number + ) + ) + order by h.requisition_number; + exec sql open rc1; + if sqlcode < 0; + writeMsg('SQL open failed: SQLCODE=' + %char(sqlcode) + + ' STATE=' + sqlstate); + leavesr; + endif; + + dow numReqs < %elem(reqs); + exec sql fetch rc1 into :cReqNbr, :cReqBy, :cNeedBy, :cTotEst, + :cVndCd, :cVndNm; + if sqlcode = 100 or sqlcode < 0; + leave; + endif; + numReqs += 1; + reqs(numReqs).reqnbr = cReqNbr; + reqs(numReqs).reqby = cReqBy; + reqs(numReqs).needby = cNeedBy; + reqs(numReqs).totest = cTotEst; + reqs(numReqs).vndcd = cVndCd; + reqs(numReqs).vndnm = cVndNm; + reqs(numReqs).isSel = *off; + enddo; + exec sql close rc1; +endsr; + +// --------------------------------------------------------------------- +begsr fillSSFL; + rrn = 0; + *in31 = *on; + write ssctl; + *in31 = *off; + for i = 1 to numReqs; + ssopt = ''; + ssreqnbr = %char(reqs(i).reqnbr); + ssreqby = reqs(i).reqby; + ssneedby = reqs(i).needby; + ssvndr = reqs(i).vndcd; + ssvndnm = reqs(i).vndnm; + sstotest = reqs(i).totest; + rrn += 1; + write ssfl; + endfor; +endsr; + +// --------------------------------------------------------------------- +// buildPlan -- for each selected req, iterate its unconverted lines, +// look up the preferred vendor + current price, add to the vendor's +// plan bucket. Multiple selected reqs -> same vendor -> same bucket +// (consolidation). Different items on same req -> different vendors +// -> different buckets (splitting). +// --------------------------------------------------------------------- +begsr buildPlan; + numPlan = 0; + lineCnt = 0; + + for i = 1 to numReqs; + if not reqs(i).isSel; + iter; + endif; + + xReqNbr = reqs(i).reqnbr; + + exec sql declare rc2 cursor for + select rl.line_number, rl.item_number, rl.quantity, + rl.uom_code, + coalesce(iv.vendor_code, ''), + coalesce(ven.vendor_name, ''), + coalesce(ivp.unit_price, rl.est_unit_cost) + from perpdemo.requisition_line rl + left join perpdemo.item_vendor iv + on iv.company_code = rl.company_code + and iv.item_number = rl.item_number + and iv.is_preferred = 'Y' + left join perpdemo.vendor ven + on ven.company_code = iv.company_code + and ven.vendor_code = iv.vendor_code + left join perpdemo.item_vendor_price ivp + on ivp.company_code = iv.company_code + and ivp.item_number = iv.item_number + and ivp.vendor_code = iv.vendor_code + and ivp.effective_to is null + where rl.company_code = :compcd + and rl.requisition_number = :xReqNbr + and not exists ( + select 1 from perpdemo.po_line pl + where pl.company_code = rl.company_code + and pl.source_requisition_number = rl.requisition_number + and pl.source_requisition_line_number = rl.line_number + ) + order by rl.line_number; + exec sql open rc2; + if sqlcode < 0; + writeMsg('buildPlan open failed: SQLCODE=' + %char(sqlcode)); + leavesr; + endif; + + dow '1'; + exec sql fetch rc2 into :cReqLine, :cItem, :cQty, :cUom, + :cVndCd, :cVndNm, :cPrice; + if sqlcode = 100 or sqlcode < 0; + leave; + endif; + + if cVndCd = ''; + // No preferred vendor -- skip this line with a warning. + writeMsg('Skipped req ' + %char(reqs(i).reqnbr) + + ' line ' + %char(cReqLine) + + ' (' + %trim(cItem) + '): no preferred vendor.'); + iter; + endif; + + // Find or add the vendor bucket. + vidx = 0; + for j = 1 to numPlan; + if plan(j).vndcd = cVndCd; + vidx = j; + leave; + endif; + endfor; + if vidx = 0; + if numPlan >= %elem(plan); + writeMsg('Too many distinct vendors -- capping preview.'); + leave; + endif; + numPlan += 1; + vidx = numPlan; + plan(vidx).vndcd = cVndCd; + plan(vidx).vndnm = cVndNm; + plan(vidx).lineCount = 0; + plan(vidx).totAmt = 0; + endif; + + if plan(vidx).lineCount >= %elem(plan(vidx).lines); + writeMsg('Too many lines for vendor ' + %trim(cVndCd) + + ' -- capping.'); + iter; + endif; + + plan(vidx).lineCount += 1; + k = plan(vidx).lineCount; + plan(vidx).lines(k).reqnbr = reqs(i).reqnbr; + plan(vidx).lines(k).reqline = cReqLine; + plan(vidx).lines(k).item = cItem; + plan(vidx).lines(k).qty = cQty; + plan(vidx).lines(k).uom = cUom; + plan(vidx).lines(k).price = cPrice; + plan(vidx).totAmt += cQty * cPrice; + lineCnt += 1; + enddo; + exec sql close rc2; + endfor; +endsr; + +// --------------------------------------------------------------------- +// showPreview -- populate SPREV plain-record fields for up to 5 +// vendor buckets, EXFMT, wait for F6 (confirm) or F12 (back). +// --------------------------------------------------------------------- +begsr showPreview; + pselcnt = selCnt; + plncnt = lineCnt; + ppocnt = numPlan; + + *in60 = *off; + *in61 = *off; + *in62 = *off; + *in63 = *off; + *in64 = *off; + *in34 = *off; + + if numPlan >= 1; + *in60 = *on; + p1vndr = plan(1).vndcd; + p1vndnm = plan(1).vndnm; + p1lns = plan(1).lineCount; + p1tot = plan(1).totAmt; + endif; + if numPlan >= 2; + *in61 = *on; + p2vndr = plan(2).vndcd; + p2vndnm = plan(2).vndnm; + p2lns = plan(2).lineCount; + p2tot = plan(2).totAmt; + endif; + if numPlan >= 3; + *in62 = *on; + p3vndr = plan(3).vndcd; + p3vndnm = plan(3).vndnm; + p3lns = plan(3).lineCount; + p3tot = plan(3).totAmt; + endif; + if numPlan >= 4; + *in63 = *on; + p4vndr = plan(4).vndcd; + p4vndnm = plan(4).vndnm; + p4lns = plan(4).lineCount; + p4tot = plan(4).totAmt; + endif; + if numPlan >= 5; + *in64 = *on; + p5vndr = plan(5).vndcd; + p5vndnm = plan(5).vndnm; + p5lns = plan(5).lineCount; + p5tot = plan(5).totAmt; + endif; + if numPlan > 5; + *in34 = *on; + endif; + + *in40 = *off; + if msgrrn > 0; + *in40 = *on; + endif; + write rmsgctl; + exfmt sprev; +endsr; + +// --------------------------------------------------------------------- +// createPOs -- one PO per vendor bucket. Snapshots buyer_code from +// vendor; allocates po_number from docseq_next('PO'); inserts po_header +// + po_line rows; each po_line carries source_requisition_number + +// source_requisition_line_number for the derived converted-status +// lookup. +// --------------------------------------------------------------------- +begsr createPOs; + poCount = 0; + + for v = 1 to numPlan; + if plan(v).lineCount = 0; + iter; + endif; + + // Copy vendor bucket into scalars (SQLRPGLE precompiler doesn't + // accept :plan(v).field as a host variable -- SQL0312). + xVndCd = plan(v).vndcd; + xTotAmt = plan(v).totAmt; + + // Snapshot buyer from vendor. + exec sql + select buyer_code + into :xBuyer + from perpdemo.vendor + where company_code = :compcd + and vendor_code = :xVndCd; + if sqlcode <> 0; + writeMsg('Vendor ' + %trim(xVndCd) + + ' lookup failed: SQLCODE=' + %char(sqlcode)); + exec sql rollback; + leavesr; + endif; + + newPo = docseq_next(compcd : 'PO' : docerrmsg); + if newPo = 0; + writeMsg('docseq_next failed: ' + docerrmsg); + exec sql rollback; + leavesr; + endif; + + exec sql + insert into perpdemo.po_header + (company_code, po_number, vendor_code, buyer_code, + status_code, total_amount) + values (:compcd, :newPo, :xVndCd, :xBuyer, + 'OPEN', :xTotAmt); + if sqlcode < 0; + writeMsg('po_header insert failed: SQLCODE=' + %char(sqlcode) + + ' STATE=' + sqlstate); + exec sql rollback; + leavesr; + endif; + + lineNbr = 0; + for L = 1 to plan(v).lineCount; + lineNbr += 1; + xItem = plan(v).lines(L).item; + xQty = plan(v).lines(L).qty; + xUom = plan(v).lines(L).uom; + xPrice = plan(v).lines(L).price; + xReqNbr = plan(v).lines(L).reqnbr; + xReqLine = plan(v).lines(L).reqline; + exec sql + insert into perpdemo.po_line + (company_code, po_number, line_number, item_number, + ordered_qty, uom_code, unit_price, + source_requisition_number, source_requisition_line_number) + values (:compcd, :newPo, :lineNbr, + :xItem, :xQty, :xUom, :xPrice, + :xReqNbr, :xReqLine); + if sqlcode < 0; + writeMsg('po_line insert failed for vendor ' + + %trim(plan(v).vndcd) + ': SQLCODE=' + + %char(sqlcode) + ' STATE=' + sqlstate); + exec sql rollback; + leavesr; + endif; + endfor; + + poCount += 1; + endfor; + + writeMsg('Created ' + %char(poCount) + ' PO(s) from ' + + %char(selCnt) + ' requisition(s) (' + + %char(lineCnt) + ' line(s)).'); +endsr; + +// --------------------------------------------------------------------- +begsr clearMsgs; + msgrrn = 0; + *in41 = *on; + write rmsgctl; + *in41 = *off; +endsr; + +// --------------------------------------------------------------------- +dcl-proc writeMsg; + dcl-pi *n; + text varchar(256) const; + end-pi; + dcl-s data char(256); + data = text; + QMHSNDPM( + 'CPF9897' : + 'QCPFMSG QSYS ' : + data : + %len(text) : + '*INFO ' : + '* ' : + 1 : + smsgkey : + x'0000000000000000'); + msgrrn += 1; + spgmq = statusDS.programName; + write rmsgsfl; +end-proc; diff --git a/perp/qrpglesrc/poschr.sqlrpgle b/perp/qrpglesrc/poschr.sqlrpgle new file mode 100644 index 00000000..0c5be6df --- /dev/null +++ b/perp/qrpglesrc/poschr.sqlrpgle @@ -0,0 +1,507 @@ +**free + +// --------------------------------------------------------------------- +// Program: poschr (Blanket PO Schedule Maintenance) +// Purpose: Maintain po_line_schedule rows for a given (company, +// po_number, line_number). Blanket POs use a schedule row per +// delivery; a non-blanket line simply has zero schedule rows. +// Company comes from *LDA[1:3] via perpselr. PO and line are +// entered on the header screen (or arrive via optional call +// parameters -- see the parm list on the entry procedure). +// +// Total scheduled qty is compared against po_line.ordered_qty +// on every refresh. Excess is highlighted with indicator 70 +// (red warning line) and a message -- soft, not a hard block, +// per the PERP-40 requirement. +// Epic: PERP-7 (PERP-40) +// --------------------------------------------------------------------- + +// datfmt(*iso) for consistency with the other PO programs -- the job +// DATFMT here is *MDY (2-digit year, 1940-2039). +ctl-opt dftactgrp(*no) actgrp(*new) datfmt(*iso); + +dcl-f poschd workstn sfile(hsfl:rrn) sfile(hmsgsfl:msgrrn); + +dcl-ds ldaDS dtaara(*lda) len(1024) qualified; + compcd char(3) pos(1); +end-ds; + +dcl-pr QMHSNDPM extpgm; + msgId char(7) const; + msgF char(20) const; + msgData char(256) const; + msgDataLen int(10) const; + msgType char(10) const; + stackEntry char(10) const; + stackCntr int(10) const; + msgKey char(4); + errorCode char(8) const; +end-pr; + +dcl-ds statusDS psds qualified; + programName char(10) pos(334); +end-ds; + +// Optional entry parameters. When both parms carry non-blank data the +// header screen is skipped and the schedule is loaded immediately. A +// call with no parms drops the user on the header entry screen. +// Optional parms via OPTIONS(*NOPASS) -- menu option calls with none, +// PO detail calls with both (PERP-41 wires this). +dcl-pi *n; + in_ponbr char(10) const options(*nopass); + in_line packed(3:0) const options(*nopass); +end-pi; + +dcl-ds schedRow qualified; + seq int(10); + schdt date; + qty packed(15:4); + rcvqty packed(15:4); + notes varchar(240); +end-ds; + +dcl-ds rows likeds(schedRow) dim(500); +dcl-s numRows int(10); +dcl-s rrn int(10); +dcl-s msgrrn int(10); +dcl-s selRrn int(10); +dcl-s changeRrn int(10); +dcl-s i int(10); +dcl-s compcd char(3); +dcl-s ponbr int(20); +dcl-s lineNbr int(10); +dcl-s chgSeq int(10); +dcl-s nextSeq int(10); +dcl-s selOpt char(1); +dcl-s cnt int(10); +dcl-s parmed ind; +dcl-s calledWithParms ind; +// po_line context for the header. +dcl-s itemNbr varchar(25); +dcl-s vndCd varchar(10); +dcl-s ordQty packed(15:4); +dcl-s uomCd varchar(5); +dcl-s schTot packed(15:4); +dcl-s rcvTot packed(15:4); + +in ldaDS; +compcd = ldaDS.compcd; + +if compcd = ''; + exsr clearMsgs; + writeMsg('No company selected - run Select Company (PERPSELR) first.'); + *in40 = *on; + hcompdsp = ''; + hponbr = ''; + hline = 0; + write hmsgctl; + exfmt hhead; + *inlr = *on; + return; +endif; + +hcompdsp = compcd; + +// Prefill from parms when supplied. Guard reads with %parms() because +// the parms are OPTIONS(*NOPASS) -- menu callers pass none. +parmed = *off; +if %parms() >= 2; + if %trim(in_ponbr) <> '' and in_line > 0; + hponbr = in_ponbr; + hline = in_line; + parmed = *on; + endif; +endif; + +// ----------------------------------------------------------------------- +// Header entry loop -- collect (or accept from parms) po_number + line; +// look them up on po_line to prove they exist and grab item / vendor / +// ordered_qty / uom for the detail screen. +// ----------------------------------------------------------------------- +dow '1'; + if not parmed; + *in40 = *off; + if msgrrn > 0; + *in40 = *on; + endif; + write hmsgctl; + exfmt hhead; + + if *in03 or *in12; + *inlr = *on; + return; + endif; + endif; + + exsr clearMsgs; + + if %trim(hponbr) = ''; + writeMsg('PO Number is required.'); + parmed = *off; + iter; + endif; + + monitor; + ponbr = %int(%trim(hponbr)); + on-error; + writeMsg('PO Number ' + %trim(hponbr) + ' must be numeric.'); + parmed = *off; + iter; + endmon; + + if hline <= 0; + writeMsg('Line Number must be greater than zero.'); + parmed = *off; + iter; + endif; + lineNbr = hline; + + exec sql + select item_number, + (select vendor_code from perpdemo.po_header + where company_code = :compcd and po_number = :ponbr), + ordered_qty, uom_code, received_qty + into :itemNbr, :vndCd, :ordQty, :uomCd, :rcvTot + from perpdemo.po_line + where company_code = :compcd + and po_number = :ponbr + and line_number = :lineNbr; + if sqlcode = 100; + writeMsg('PO ' + %char(ponbr) + ' line ' + %char(lineNbr) + + ' not found.'); + parmed = *off; + iter; + endif; + if sqlcode < 0; + writeMsg('Lookup failed: SQLCODE=' + %char(sqlcode)); + parmed = *off; + iter; + endif; + + leave; +enddo; + +// PERP-95: remember whether this invocation ever showed the header +// entry screen (hhead). parmed is only ever cleared inside the loop +// above, never re-set once cleared, so its value here tells us +// whether hhead was skipped entirely (called with valid parms from +// PO Browse -- no earlier screen to step back to) or was displayed +// at least once (standalone menu invocation -- there IS an earlier +// screen conceptually behind the schedule list). +calledWithParms = parmed; + +// ----------------------------------------------------------------------- +// Schedule maintenance loop. +// ----------------------------------------------------------------------- +dow '1'; + exsr loadSched; + + if numRows = 0; + *in30 = *off; + write hnosch; + else; + exsr fillSubfile; + *in30 = *on; + endif; + + // Header context. + dponbr = hponbr; + dline = lineNbr; + ditem = itemNbr; + dvndcd = vndCd; + dordqty = ordQty; + duom = uomCd; + dschtot = schTot; + drcvtot = rcvTot; + *in70 = *off; + if schTot > ordQty; + *in70 = *on; + endif; + + write hfoot; + *in40 = *off; + if msgrrn > 0; + *in40 = *on; + endif; + write hmsgctl; + exfmt hsctl; + + // PERP-95: F3 always exits. F12 exits only when this invocation was + // called with parms from PO Browse (no header screen was shown, so + // F12 correctly returns control to that caller). When invoked + // standalone from the menu, the header screen (hhead) was shown + // first, so F12 here should just redisplay this list, not end the + // program. + if *in03; + leave; + endif; + if *in12; + if calledWithParms; + leave; + endif; + iter; + endif; + + exsr clearMsgs; + + if *in06; + exsr addSched; + iter; + endif; + + // Drain READC loop before switching to HEDIT for a change + // (DDL_STYLE_GUIDE.md Sec.14 pattern). + if numRows > 0; + selRrn = 0; + selOpt = ' '; + changeRrn = 0; + readc hsfl; + dow not %eof(poschd); + if slopt <> ''; + selRrn = rrn; + selOpt = slopt; + exsr handleOpt; + selRrn = 0; + endif; + readc hsfl; + enddo; + + if changeRrn > 0 and msgrrn = 0; + selRrn = changeRrn; + exsr changeSched; + endif; + endif; + +enddo; + +*inlr = *on; +return; + +// --------------------------------------------------------------------- +begsr loadSched; + numRows = 0; + schTot = 0; + + exec sql declare sc1 cursor for + select schedule_seq, scheduled_date, scheduled_qty, received_qty, + notes + from perpdemo.po_line_schedule + where company_code = :compcd + and po_number = :ponbr + and line_number = :lineNbr + order by schedule_seq; + exec sql open sc1; + if sqlcode < 0; + writeMsg('SQL open failed: SQLCODE=' + %char(sqlcode)); + leavesr; + endif; + + dow numRows < %elem(rows); + exec sql fetch sc1 into :schedRow.seq, :schedRow.schdt, + :schedRow.qty, :schedRow.rcvqty, + :schedRow.notes; + if sqlcode = 100 or sqlcode < 0; + leave; + endif; + numRows += 1; + rows(numRows) = schedRow; + schTot += schedRow.qty; + enddo; + exec sql close sc1; + + // Refresh po_line.received_qty (a receipt program may have updated it). + exec sql + select received_qty + into :rcvTot + from perpdemo.po_line + where company_code = :compcd + and po_number = :ponbr + and line_number = :lineNbr; +endsr; + +// --------------------------------------------------------------------- +begsr fillSubfile; + rrn = 0; + *in31 = *on; + write hsctl; + *in31 = *off; + for i = 1 to numRows; + slopt = ''; + slseq = rows(i).seq; + slschdt = rows(i).schdt; + slschqty = rows(i).qty; + slrcvqty = rows(i).rcvqty; + slschnot = rows(i).notes; + rrn += 1; + write hsfl; + endfor; +endsr; + +// --------------------------------------------------------------------- +begsr handleOpt; + chain selRrn hsfl; + if %found(poschd); + select; + when selOpt = '2'; + if changeRrn = 0; + changeRrn = selRrn; + else; + writeMsg('Only one row may be changed per Enter.'); + endif; + when selOpt = '4'; + exsr deleteSched; + other; + writeMsg('Option ' + selOpt + ' not valid.'); + endsl; + endif; +endsr; + +// --------------------------------------------------------------------- +begsr addSched; + emode = 'A'; + eseq = 0; + eschdt = %date(); + eschqty = 0; + ercvqty = 0; + enotes = ''; + + dow '1'; + exfmt hedit; + if *in12; + leavesr; + endif; + + if eschqty <= 0; + writeMsg('Scheduled Qty must be greater than zero.'); + iter; + endif; + + if ercvqty < 0; + writeMsg('Received Qty cannot be negative.'); + iter; + endif; + + if ercvqty > eschqty; + writeMsg('Received Qty cannot exceed Scheduled Qty.'); + iter; + endif; + + leave; + enddo; + + exec sql + select coalesce(max(schedule_seq), 0) + 1 + into :nextSeq + from perpdemo.po_line_schedule + where company_code = :compcd + and po_number = :ponbr + and line_number = :lineNbr; + + exec sql + insert into perpdemo.po_line_schedule + (company_code, po_number, line_number, schedule_seq, + scheduled_date, scheduled_qty, received_qty, notes) + values (:compcd, :ponbr, :lineNbr, :nextSeq, + :eschdt, :eschqty, :ercvqty, :enotes); + if sqlcode < 0; + writeMsg('Add failed: SQLCODE=' + %char(sqlcode) + + ' STATE=' + sqlstate); + leavesr; + endif; + + exec sql commit; + writeMsg('Added schedule seq ' + %char(nextSeq) + ' (' + + %char(eschqty) + ' on ' + %char(eschdt) + ').'); +endsr; + +// --------------------------------------------------------------------- +begsr changeSched; + chgSeq = rows(selRrn).seq; + emode = 'C'; + eseq = chgSeq; + eschdt = rows(selRrn).schdt; + eschqty = rows(selRrn).qty; + ercvqty = rows(selRrn).rcvqty; + enotes = rows(selRrn).notes; + + exfmt hedit; + if *in12; + leavesr; + endif; + + if eschqty <= 0; + writeMsg('Scheduled Qty must be greater than zero.'); + leavesr; + endif; + + if ercvqty < 0 or ercvqty > eschqty; + writeMsg('Received Qty must be between 0 and Scheduled Qty.'); + leavesr; + endif; + + exec sql + update perpdemo.po_line_schedule + set scheduled_date = :eschdt, + scheduled_qty = :eschqty, + received_qty = :ercvqty, + notes = :enotes, + updated_at = current_timestamp, + updated_by = user + where company_code = :compcd + and po_number = :ponbr + and line_number = :lineNbr + and schedule_seq = :chgSeq; + if sqlcode < 0; + writeMsg('Change failed: SQLCODE=' + %char(sqlcode)); + leavesr; + endif; + + exec sql commit; + writeMsg('Updated schedule seq ' + %char(chgSeq) + '.'); +endsr; + +// --------------------------------------------------------------------- +begsr deleteSched; + exec sql + delete from perpdemo.po_line_schedule + where company_code = :compcd + and po_number = :ponbr + and line_number = :lineNbr + and schedule_seq = :slseq; + if sqlcode < 0; + writeMsg('Delete failed: SQLSTATE=' + sqlstate); + leavesr; + endif; + exec sql commit; + writeMsg('Deleted schedule seq ' + %char(slseq) + '.'); +endsr; + +// --------------------------------------------------------------------- +begsr clearMsgs; + msgrrn = 0; + *in41 = *on; + write hmsgctl; + *in41 = *off; +endsr; + +// --------------------------------------------------------------------- +dcl-proc writeMsg; + dcl-pi *n; + text varchar(256) const; + end-pi; + dcl-s data char(256); + data = text; + QMHSNDPM( + 'CPF9897' : + 'QCPFMSG QSYS ' : + data : + %len(text) : + '*INFO ' : + '* ' : + 1 : + smsgkey : + x'0000000000000000'); + msgrrn += 1; + spgmq = statusDS.programName; + write hmsgsfl; +end-proc; diff --git a/perp/qrpglesrc/rcnbrwr.sqlrpgle b/perp/qrpglesrc/rcnbrwr.sqlrpgle new file mode 100644 index 00000000..a0aa3a52 --- /dev/null +++ b/perp/qrpglesrc/rcnbrwr.sqlrpgle @@ -0,0 +1,264 @@ +**free + +// --------------------------------------------------------------------- +// Program: rcnbrwr (Reconciliation Log Browse & Inquiry) +// Purpose: Filterable subfile of reconciliation_log rows (item, +// reconciled_by, run_timestamp date range). Option 5 drills to +// a plain-record detail showing before/after values + notes. +// No F6=Add -- this table is populated exclusively by the +// lotrecon service (PERP-44), never by hand, same reasoning +// pobrwd already applies (browse-only screens in this module +// omit F6). +// Epic: PERP-8 (PERP-45) +// --------------------------------------------------------------------- + +// datfmt(*iso) is REQUIRED here (not decorative) -- filter defaults use +// 1940-01-01 / 2039-12-31 as sentinels, and the job DATFMT on this +// environment is *MDY (2-digit year, 1940-2039). Without this ctl-opt, +// every Date variable in this program is capped at *MDY's range and +// RNQ0114 fires at runtime the first time the DSPF WRITEs the FFRDT/ +// FTODT fields or the SQL fetches one. Same fix pobrwr needed. +ctl-opt dftactgrp(*no) actgrp(*new) datfmt(*iso); + +dcl-f rcnbrwd workstn sfile(lsfl:rrn) sfile(rmsgsfl:msgrrn); + +dcl-ds ldaDS dtaara(*lda) len(1024) qualified; + compcd char(3) pos(1); +end-ds; + +dcl-pr QMHSNDPM extpgm; + msgId char(7) const; + msgF char(20) const; + msgData char(256) const; + msgDataLen int(10) const; + msgType char(10) const; + stackEntry char(10) const; + stackCntr int(10) const; + msgKey char(4); + errorCode char(8) const; +end-pr; + +dcl-ds statusDS psds qualified; + programName char(10) pos(334); +end-ds; + +dcl-ds reconRow qualified; + id int(10); + item varchar(25); + qbef packed(11:4); + qaft packed(11:4); + rcnby varchar(18); +end-ds; + +dcl-ds rows likeds(reconRow) dim(500); +dcl-s numRows int(10); +dcl-s rrn int(10); +dcl-s msgrrn int(10); +dcl-s selRrn int(10); +dcl-s selOpt char(1); +dcl-s selId int(10); +dcl-s i int(10); +dcl-s compcd char(3); + +// Cursor scalars. +dcl-s cId int(10); +dcl-s cItem varchar(25); +dcl-s cQbef packed(11:4); +dcl-s cQaft packed(11:4); +dcl-s cRcnby varchar(18); + +in ldaDS; +compcd = ldaDS.compcd; + +if compcd = ''; + exsr clearMsgs; + writeMsg('No company selected - run Select Company (PERPSELR) first.'); + *in40 = *on; + lcompdsp = ''; + write rmsgctl; + exfmt lfoot; + *inlr = *on; + return; +endif; + +lcompdsp = compcd; +fitem = ''; +frcnby = ''; +// Filter sentinels must stay within the *MDY 1940-2039 range -- see +// ctl-opt comment above and pobrwr's own identical fix. +ffrdt = %date('1940-01-01' : *ISO); +ftodt = %date('2039-12-31' : *ISO); + +// ----------------------------------------------------------------------- +// Browse loop. +// ----------------------------------------------------------------------- +dow '1'; + exsr loadRows; + + if numRows = 0; + *in30 = *off; + write lnorows; + else; + exsr fillSubfile; + *in30 = *on; + endif; + + write lfoot; + *in40 = *off; + if msgrrn > 0; + *in40 = *on; + endif; + write rmsgctl; + exfmt lctl; + + if *in03 or *in12; + leave; + endif; + + exsr clearMsgs; + + if numRows > 0; + selRrn = 0; + selOpt = ' '; + readc lsfl; + dow not %eof(rcnbrwd); + if lsopt <> ''; + if selRrn = 0; + selRrn = rrn; + selOpt = lsopt; + else; + writeMsg('Only one selection per Enter.'); + endif; + endif; + readc lsfl; + enddo; + + if selRrn > 0 and msgrrn = 0; + select; + when selOpt = '5'; + selId = rows(selRrn).id; + exsr showDetail; + other; + writeMsg('Option ' + selOpt + ' not valid.'); + endsl; + endif; + endif; +enddo; + +*inlr = *on; +return; + +// --------------------------------------------------------------------- +// loadRows -- pull reconciliation_log rows matching the current filter +// values. Empty filter fields skip that filter (fitem='' means "any +// item", etc.). +begsr loadRows; + numRows = 0; + + exec sql declare lc1 cursor for + select reconciliation_id, item_number, item_qty_before, qty_after, + reconciled_by + from perpdemo.reconciliation_log + where company_code = :compcd + and (:fitem = '' or item_number = :fitem) + and (:frcnby = '' or reconciled_by = :frcnby) + and cast(run_timestamp as date) between :ffrdt and :ftodt + order by reconciliation_id desc; + exec sql open lc1; + if sqlcode < 0; + writeMsg('SQL open failed: SQLCODE=' + %char(sqlcode) + + ' STATE=' + sqlstate); + return; + endif; + + dow numRows < %elem(rows); + exec sql fetch lc1 into :cId, :cItem, :cQbef, :cQaft, :cRcnby; + if sqlcode = 100 or sqlcode < 0; + leave; + endif; + numRows += 1; + rows(numRows).id = cId; + rows(numRows).item = cItem; + rows(numRows).qbef = cQbef; + rows(numRows).qaft = cQaft; + rows(numRows).rcnby = cRcnby; + enddo; + exec sql close lc1; +endsr; + +// --------------------------------------------------------------------- +begsr fillSubfile; + rrn = 0; + *in31 = *on; + write lctl; + *in31 = *off; + for i = 1 to numRows; + lsopt = ''; + lsid = rows(i).id; + lsitem = rows(i).item; + lsqbef = rows(i).qbef; + lsqaft = rows(i).qaft; + // Direct assign VARCHAR -> fixed CHAR: RPG right-pads/truncates + // automatically. %subst is strict about CURRENT length, not + // declared max (DDL_STYLE_GUIDE Sec.13) -- don't use it here. + lsrcnby = rows(i).rcnby; + rrn += 1; + write lsfl; + endfor; +endsr; + +// --------------------------------------------------------------------- +// showDetail -- populate LDETAIL fields for the selected reconciliation +// row. EXFMT once; F12 returns to the browse. +begsr showDetail; + exec sql + select reconciliation_id, item_number, char(run_timestamp), + item_qty_before, lot_sum_before, qty_after, reconciled_by, + notes + into :ddid, :dditem, :ddrunts, :ddqbef, :ddlsum, :ddqaft, + :ddrcnby, :ddnotes + from perpdemo.reconciliation_log + where company_code = :compcd and reconciliation_id = :selId; + if sqlcode <> 0; + writeMsg('Reconciliation ' + %char(selId) + ' lookup failed: SQLCODE=' + + %char(sqlcode)); + return; + endif; + + *in40 = *off; + if msgrrn > 0; + *in40 = *on; + endif; + write rmsgctl; + exfmt ldetail; +endsr; + +// --------------------------------------------------------------------- +begsr clearMsgs; + msgrrn = 0; + *in41 = *on; + write rmsgctl; + *in41 = *off; +endsr; + +// --------------------------------------------------------------------- +dcl-proc writeMsg; + dcl-pi *n; + text varchar(256) const; + end-pi; + dcl-s data char(256); + data = text; + QMHSNDPM( + 'CPF9897' : + 'QCPFMSG QSYS ' : + data : + %len(text) : + '*INFO ' : + '* ' : + 1 : + smsgkey : + x'0000000000000000'); + msgrrn += 1; + spgmq = statusDS.programName; + write rmsgsfl; +end-proc; diff --git a/perp/qrpglesrc/rcventr.sqlrpgle b/perp/qrpglesrc/rcventr.sqlrpgle new file mode 100644 index 00000000..ba31437c --- /dev/null +++ b/perp/qrpglesrc/rcventr.sqlrpgle @@ -0,0 +1,539 @@ +**free + +// --------------------------------------------------------------------- +// Program: rcventr (PO Receipt Entry) +// Purpose: DSPF-based receipt entry, scoped by the company selected via +// perpselr (*LDA positions 1-3). Header screen picks a PO +// (must be OPEN or PARTIAL) and a receiver; allocates the doc +// number via docseq_next('RCP') and inserts a POSTED header -- +// there is no DRAFT workflow here, unlike poentr/reqentr: +// creating a receipt line IS the act of receiving. +// +// Line screen is a subfile of the PO's still-open lines +// (status_code <> CLOSED), joined to po_line_open for open_qty. +// Per-line action is subfile Option 1=Receive, not F6=Add -- +// every receipt line originates from an existing open po_line, +// unlike poentr where F6 creates a brand-new row from nothing. +// Receiving a line: converts vendor UOM -> inventory UOM via +// item_uom_conversion, upserts item_lot for lot-controlled +// items, and rolls po_line.received_qty/status_code and +// po_header.status_code forward -- the PO-status-transition- +// from-receipts item PERP-7's recap deferred to this epic. +// Epic: PERP-8 (PERP-43) +// --------------------------------------------------------------------- + +// datfmt(*iso) kept for consistency with every other PERP program that +// touches Date fields (DDS DATFMT(*ISO) fields) -- no out-of-range +// sentinel date is used here (receipt_date always defaults to a real +// %date()), so the *MDY host-variable trap (DDL_STYLE_GUIDE Sec.13) +// does not apply to this program the way it did to poentr/pobrwr. +ctl-opt dftactgrp(*no) actgrp(*new) bnddir('PERP') datfmt(*iso); + +dcl-f rcventd workstn sfile(rlsfl:rrn) sfile(rmsgsfl:msgrrn); + +/copy docseq_pr.rpgle + +dcl-ds ldaDS dtaara(*lda) len(1024) qualified; + compcd char(3) pos(1); +end-ds; + +dcl-pr QMHSNDPM extpgm; + msgId char(7) const; + msgF char(20) const; + msgData char(256) const; + msgDataLen int(10) const; + msgType char(10) const; + stackEntry char(10) const; + stackCntr int(10) const; + msgKey char(4); + errorCode char(8) const; +end-pr; + +// Standard, reusable PO Number prompt (PERP-51/PERP-98). Numeric field, +// so invoked via F4=Prompt rather than the "?" convention item/vendor +// prompts use. Same dynamic CALL idiom as wrkitmr's callWrkcnvr etc. +dcl-pr callPoprmt extpgm('POPRMT'); + pCompcd char(3) const; + pPonbr packed(15:0); +end-pr; + +dcl-ds statusDS psds qualified; + programName char(10) pos(334); +end-ds; + +dcl-ds lineRow qualified; + lnbr int(10); + item varchar(25); + desc varchar(30); + openqty packed(11:4); + uom varchar(5); +end-ds; + +dcl-ds rows likeds(lineRow) dim(500); +dcl-s numRows int(10); +dcl-s i int(10); +dcl-s rrn int(10); +dcl-s msgrrn int(10); +dcl-s selRrn int(10); +dcl-s selOpt char(1); +dcl-s compcd char(3); +dcl-s rcpnbr int(20); +dcl-s docerrmsg varchar(80); +dcl-s hvndnmW varchar(60); +dcl-s hrcvnmW varchar(60); +dcl-s dvndnmW varchar(60); +dcl-s invuom varchar(5); +dcl-s convFactor packed(15:6); +dcl-s qtyInv packed(15:4); +dcl-s nextRLine int(10); +dcl-s newHdrStat varchar(20); +dcl-s promptPonbr packed(15:0); + +in ldaDS; +compcd = ldaDS.compcd; + +if compcd = ''; + exsr clearMsgs; + writeMsg('No company selected - run Select Company (PERPSELR) first.'); + *in40 = *on; + write rmsgctl; + hcompdsp = ''; + exfmt rhead; + *inlr = *on; + return; +endif; + +hcompdsp = compcd; + +// ----------------------------------------------------------------------- +// Header entry -- pick PO, receipt date, receiver, notes. Validate the +// PO exists for this company and is still open to receive against. +// ----------------------------------------------------------------------- +hponbr = 0; +hrcpdt = %date(); +hrcvby = ''; +hnotes = ''; + +exsr clearMsgs; + +dow '1'; + *in40 = *off; + if msgrrn > 0; + *in40 = *on; + endif; + write rmsgctl; + exfmt rhead; + + if *in03 or *in12; + *inlr = *on; + return; + endif; + + exsr clearMsgs; + + // PO Number prompt (PERP-98): F4 invokes the standard reusable PO + // Number lookup (lists POs still awaiting receipt) and returns the + // selection. HPONBR is numeric, so this uses F4=Prompt rather than + // the "?" + Enter convention item/vendor fields use. + if *in04; + promptPonbr = hponbr; + callPoprmt(compcd : promptPonbr); + hponbr = promptPonbr; + iter; + endif; + + if hponbr <= 0; + writeMsg('PO Number is required.'); + iter; + endif; + + exec sql + select h.status_code, v.vendor_name + into :hpostat, :hvndnmW + from perpdemo.po_header h + join perpdemo.vendor v + on v.company_code = h.company_code and v.vendor_code = h.vendor_code + where h.company_code = :compcd and h.po_number = :hponbr; + if sqlcode <> 0; + writeMsg('PO ' + %char(hponbr) + ' not found for this company.'); + iter; + endif; + hvndnm = hvndnmW; + + if hpostat <> 'OPEN' and hpostat <> 'PARTIAL'; + writeMsg('PO ' + %char(hponbr) + ' is ' + %trim(hpostat) + + ' - not open for receiving.'); + iter; + endif; + + if %trim(hrcvby) = ''; + writeMsg('Received By is required.'); + iter; + endif; + + exec sql + select display_name + into :hrcvnmW + from perpdemo.perp_user + where user_code = :hrcvby; + if sqlcode <> 0; + writeMsg('Receiver ' + %trim(hrcvby) + ' not found.'); + iter; + endif; + hrcvnm = hrcvnmW; + + leave; +enddo; + +rcpnbr = docseq_next(compcd : 'RCP' : docerrmsg); +if rcpnbr = 0; + writeMsg('Could not allocate receipt number: ' + docerrmsg); + *inlr = *on; + return; +endif; + +// status_code/status_type default to POSTED/RCPSTATUS via the DDL +// default -- left out of the column list so a future default change +// lands here too (same idiom poentr uses for po_header.currency_code). +exec sql + insert into perpdemo.po_receipt + (company_code, receipt_number, po_number, receipt_date, received_by, + notes) + values (:compcd, :rcpnbr, :hponbr, :hrcpdt, :hrcvby, :hnotes); +if sqlcode < 0; + writeMsg('Could not create receipt: SQLCODE=' + %char(sqlcode)); + *inlr = *on; + return; +endif; + +exec sql commit; + +// ----------------------------------------------------------------------- +// Line entry -- subfile of the PO's still-open lines. +// ----------------------------------------------------------------------- +exsr clearMsgs; +writeMsg('Receipt ' + %char(rcpnbr) + ' created for PO ' + %char(hponbr) + + '. Type 1=Receive next to a line.'); + +dow '1'; + exsr loadHeaderRecap; + exsr loadOpenLines; + + if numRows = 0; + *in30 = *off; + write rnolin; + else; + exsr fillSubfile; + *in30 = *on; + endif; + + write rlfoot; + *in40 = *off; + if msgrrn > 0; + *in40 = *on; + endif; + write rmsgctl; + exfmt rlctl; + + if *in03 or *in12; + leave; + endif; + + exsr clearMsgs; + + if numRows > 0; + selRrn = 0; + selOpt = ' '; + readc rlsfl; + dow not %eof(rcventd); + if slopt <> ''; + if selRrn = 0; + selRrn = rrn; + selOpt = slopt; + else; + writeMsg('Only one selection per Enter.'); + endif; + endif; + readc rlsfl; + enddo; + + if selRrn > 0 and msgrrn = 0; + select; + when selOpt = '1'; + exsr receiveLine; + other; + writeMsg('Option ' + selOpt + ' not valid.'); + endsl; + endif; + endif; +enddo; + +*inlr = *on; +return; + +// --------------------------------------------------------------------- +begsr loadHeaderRecap; + exec sql + select h.status_code, v.vendor_code, v.vendor_name + into :hpostat, :dvndr, :dvndnmW + from perpdemo.po_header h + join perpdemo.vendor v + on v.company_code = h.company_code and v.vendor_code = h.vendor_code + where h.company_code = :compcd and h.po_number = :hponbr; + dvndnm = dvndnmW; + dponbr = %char(hponbr); + drcvby = hrcvby; + drcvnm = hrcvnm; + drcpdt = hrcpdt; + dpostat = hpostat; +endsr; + +// --------------------------------------------------------------------- +// loadOpenLines -- po_line rows still open (status_code <> CLOSED), +// joined to po_line_open for open_qty and to item for the description. +begsr loadOpenLines; + numRows = 0; + exec sql declare rc1 cursor for + select l.line_number, l.item_number, i.item_description, + o.open_qty, l.uom_code + from perpdemo.po_line l + join perpdemo.po_line_open o + on o.company_code = l.company_code and o.po_number = l.po_number + and o.line_number = l.line_number + join perpdemo.item i + on i.company_code = l.company_code and i.item_number = l.item_number + where l.company_code = :compcd and l.po_number = :hponbr + and l.status_code <> 'CLOSED' and l.is_active = 'Y' + order by l.line_number; + exec sql open rc1; + if sqlcode < 0; + writeMsg('SQL open failed: SQLCODE=' + %char(sqlcode)); + leavesr; + endif; + + dow numRows < %elem(rows); + exec sql fetch rc1 into :lineRow.lnbr, :lineRow.item, :lineRow.desc, + :lineRow.openqty, :lineRow.uom; + if sqlcode = 100 or sqlcode < 0; + leave; + endif; + numRows += 1; + rows(numRows) = lineRow; + enddo; + exec sql close rc1; +endsr; + +// --------------------------------------------------------------------- +begsr fillSubfile; + rrn = 0; + *in31 = *on; + write rlctl; + *in31 = *off; + for i = 1 to numRows; + slopt = ''; + slline = rows(i).lnbr; + slitem = rows(i).item; + sldesc = rows(i).desc; + slopen = rows(i).openqty; + sluom = rows(i).uom; + rrn += 1; + write rlsfl; + endfor; +endsr; + +// --------------------------------------------------------------------- +// receiveLine -- prompt for qty received (vendor UOM) + lot number +// (if lot-controlled), then post everywhere a receipt touches: +// po_receipt_line insert, item_lot upsert, po_line roll-up, item +// qty_on_hand bump, po_header status recalc. +begsr receiveLine; + eline = rows(selRrn).lnbr; + eitem = rows(selRrn).item; + edesc = rows(selRrn).desc; + eopen = rows(selRrn).openqty; + euom = rows(selRrn).uom; + + exec sql + select lot_controlled, inventory_uom + into :elotctl, :invuom + from perpdemo.item + where company_code = :compcd and item_number = :eitem; + + eqty = 0; + elot = ''; + enotes = ''; + + dow '1'; + *in40 = *off; + if msgrrn > 0; + *in40 = *on; + endif; + write rmsgctl; + exfmt rledit; + if *in12; + leavesr; + endif; + + exsr clearMsgs; + + if eqty <= 0; + writeMsg('Quantity must be greater than zero.'); + iter; + endif; + + if eqty > eopen; + writeMsg('Quantity exceeds open quantity of ' + %char(eopen) + '.'); + iter; + endif; + + if elotctl = 'Y' and %trim(elot) = ''; + writeMsg('Lot number is required for this lot-controlled item.'); + iter; + endif; + + leave; + enddo; + + if %trim(euom) = %trim(invuom); + convFactor = 1; + else; + exec sql + select conversion_factor + into :convFactor + from perpdemo.item_uom_conversion + where company_code = :compcd and item_number = :eitem + and from_uom = :euom and to_uom = :invuom; + if sqlcode <> 0; + writeMsg('No UOM conversion from ' + %trim(euom) + ' to ' + + %trim(invuom) + ' defined for this item.'); + leavesr; + endif; + endif; + + qtyInv = eqty * convFactor; + + exec sql + select coalesce(max(line_number), 0) + 1 + into :nextRLine + from perpdemo.po_receipt_line + where company_code = :compcd and receipt_number = :rcpnbr; + + if %trim(elot) = ''; + exec sql + insert into perpdemo.po_receipt_line + (company_code, receipt_number, line_number, po_number, + po_line_number, item_number, qty_received_vendor_uom, + qty_received_inventory_uom, uom_conversion_factor, notes) + values (:compcd, :rcpnbr, :nextRLine, :hponbr, :eline, + :eitem, :eqty, :qtyInv, :convFactor, :enotes); + else; + exec sql + insert into perpdemo.po_receipt_line + (company_code, receipt_number, line_number, po_number, + po_line_number, item_number, qty_received_vendor_uom, + qty_received_inventory_uom, uom_conversion_factor, lot_number, + notes) + values (:compcd, :rcpnbr, :nextRLine, :hponbr, :eline, + :eitem, :eqty, :qtyInv, :convFactor, :elot, :enotes); + endif; + if sqlcode < 0; + writeMsg('Receipt line insert failed: SQLCODE=' + %char(sqlcode) + + ' SQLSTATE=' + sqlstate); + leavesr; + endif; + + if elotctl = 'Y'; + exec sql + update perpdemo.item_lot + set qty_on_hand = qty_on_hand + :qtyInv, + updated_at = current_timestamp, + updated_by = user + where company_code = :compcd and item_number = :eitem + and lot_number = :elot; + if sqlcode = 100; + exec sql + insert into perpdemo.item_lot + (company_code, item_number, lot_number, qty_on_hand) + values (:compcd, :eitem, :elot, :qtyInv); + endif; + endif; + + exec sql + update perpdemo.po_line + set received_qty = received_qty + :qtyInv, + status_code = case + when received_qty + :qtyInv >= ordered_qty then 'CLOSED' + when received_qty + :qtyInv > 0 then 'PARTIAL' + else 'OPEN' + end, + updated_at = current_timestamp, + updated_by = user + where company_code = :compcd and po_number = :hponbr + and line_number = :eline; + if sqlcode < 0; + writeMsg('po_line update failed: SQLCODE=' + %char(sqlcode)); + leavesr; + endif; + + exec sql + update perpdemo.item + set qty_on_hand = qty_on_hand + :qtyInv, + updated_at = current_timestamp, + updated_by = user + where company_code = :compcd and item_number = :eitem; + + exec sql + select case + when count(*) = sum(case when status_code = 'CLOSED' then 1 else 0 end) + then 'RECEIVED' + when sum(case when received_qty > 0 then 1 else 0 end) > 0 + then 'PARTIAL' + else 'OPEN' + end + into :newHdrStat + from perpdemo.po_line + where company_code = :compcd and po_number = :hponbr and is_active = 'Y'; + + exec sql + update perpdemo.po_header + set status_code = :newHdrStat, + updated_at = current_timestamp, + updated_by = user + where company_code = :compcd and po_number = :hponbr; + + exec sql commit; + + writeMsg('Received ' + %char(eqty) + ' ' + %trim(euom) + ' (' + + %char(qtyInv) + ' ' + %trim(invuom) + ') on line ' + + %char(eline) + '.'); +endsr; + +// --------------------------------------------------------------------- +begsr clearMsgs; + msgrrn = 0; + *in41 = *on; + write rmsgctl; + *in41 = *off; +endsr; + +// --------------------------------------------------------------------- +dcl-proc writeMsg; + dcl-pi *n; + text varchar(256) const; + end-pi; + dcl-s data char(256); + data = text; + QMHSNDPM( + 'CPF9897' : + 'QCPFMSG QSYS ' : + data : + %len(text) : + '*INFO ' : + '* ' : + 1 : + smsgkey : + x'0000000000000000'); + msgrrn += 1; + spgmq = statusDS.programName; + write rmsgsfl; +end-proc; diff --git a/perp/qrpglesrc/reqaprr.sqlrpgle b/perp/qrpglesrc/reqaprr.sqlrpgle new file mode 100644 index 00000000..20e56eed --- /dev/null +++ b/perp/qrpglesrc/reqaprr.sqlrpgle @@ -0,0 +1,484 @@ +**free + +// --------------------------------------------------------------------- +// Program: reqaprr (Requisition Approval) +// Purpose: Lists SUBMITTED requisitions for the selected company +// (*LDA positions 1-3, via perpselr). Selecting a row (option +// 5=Review) shows a detail screen (header summary + up to 6 +// lines as plain fields + a confidence_pct badge) with +// Approve/Reject actions. Both actions stamp approved_by (job +// USER), approved_at, approval_source=HUMAN, and the entered +// approval_notes; the requisition leaves the SUBMITTED list +// either way. +// +// The detail screen is a single plain (non-subfile) record in +// this SAME program/file, showing up to 6 lines as +// individually-named fields, each conditioned on its own +// indicator (*in60..*in65) so an unused row is genuinely +// blank rather than displaying "0.0000". +// +// This design exists after extensive, reproducible live +// testing on this specific environment (Profound UI Genie, +// "classic" skin) ruled out a second business subfile in this +// program: +// 1. ASFL (list) + ALSFL/ALCTL (review-detail) in one +// reqaprd.dspf, entered via EXFMT ALCTL from inside the +// "5=Review" handler -- crashed with RNX1255 at EXFMT +// ALCTL, "Session or device error occurred in file +// REQAPRD". +// 2. The same design with the format switch deferred past +// the driving READC loop -- crashed identically. +// 3. Splitting the detail screen into a separate called +// program (reqapdtl) with its own device file, the same +// pattern wrkitmr uses calling wrkcnvr/wrklotr -- also +// crashed, cascading across both files. +// 4. The same two-subfile design again, this time with +// OVERLAY added everywhere (a real and independently +// confirmed DDS rule -- missing OVERLAY on a WRITE-only +// footer really can cause exactly this class of error) +// and separate SFLCLR/SFLDSP indicators matching ASFL's +// own proven-safe pattern exactly -- STILL crashed at +// the identical EXFMT ALCTL statement, confirmed via a +// genuine native-session retest (not a stale load). +// Every one of those is textbook-correct RPG/DDS and matches +// patterns already used successfully elsewhere in this +// module (or, for #3, in wrkitmr) -- yet all four crash +// identically and reproducibly on this environment, while +// this plain-fields design is the ONLY one confirmed to +// render without crashing. Treat that as an environment- +// specific limitation of this particular setup (possibly the +// Genie web-based 5250 renderer, not the RPG/DDS itself, +// though the exact reason remains unconfirmed), not a +// contradiction of standard subfile practice -- and don't +// re-attempt a second business subfile in this program +// without a real interactive test proving it actually works +// here first. +// Epic: PERP-6 (PERP-35, redesigned four times as a runtime-crash +// fix; see DDL_STYLE_GUIDE.md Sec.14 for the full history) +// --------------------------------------------------------------------- + +ctl-opt dftactgrp(*no) actgrp(*new); + +dcl-f reqaprd workstn sfile(asfl:rrn) sfile(rmsgsfl:msgrrn); + +dcl-ds ldaDS dtaara(*lda) len(1024) qualified; + compcd char(3) pos(1); +end-ds; + +dcl-pr QMHSNDPM extpgm; + msgId char(7) const; + msgF char(20) const; + msgData char(256) const; + msgDataLen int(10) const; + msgType char(10) const; + stackEntry char(10) const; + stackCntr int(10) const; + msgKey char(4); + errorCode char(8) const; +end-pr; + +dcl-ds statusDS psds qualified; + programName char(10) pos(334); +end-ds; + +dcl-ds reqRow qualified; + reqnbr int(20); + reqby varchar(10); + needby date; + pricd varchar(20); + totest packed(15:2); + conf varchar(8); +end-ds; + +dcl-ds lineRow2 qualified; + item varchar(25); + qty packed(15:4); + uom varchar(5); + cost packed(15:4); +end-ds; + +dcl-c MAXDTLLINES 6; + +dcl-ds reqs likeds(reqRow) dim(500); +dcl-ds detailLines likeds(lineRow2) dim(500); + +dcl-s numReqs int(10); +dcl-s numLines int(10); +dcl-s i int(10); +dcl-s rrn int(10); +dcl-s msgrrn int(10); +dcl-s selRrn int(10); +dcl-s reviewRrn int(10); +dcl-s selOpt char(1); +dcl-s compcd char(3); +dcl-s selReqnbr int(20); +dcl-s confPct packed(5:2); +dcl-s confInd int(5); +dcl-s holdMsg ind; + +in ldaDS; +compcd = ldaDS.compcd; + +if compcd = ''; + exsr clearMsgs; + writeMsg('No company selected - run Select Company (PERPSELR) first.'); + *in40 = *on; + write rmsgctl; + lcompdsp = ''; + write rlfoot; + exfmt asctl; + *inlr = *on; + return; +endif; + +lcompdsp = compcd; + +dow '1'; + // PERP-87: a confirmation queued by reviewReq's Approve/Reject just + // before returning here must survive one pass before clearMsgs + // wipes it, or it never reaches the screen -- same holdMsg pattern + // as PERP-74/PERP-86. + if holdMsg; + holdMsg = *off; + else; + exsr clearMsgs; + endif; + exsr loadReqs; + + if numReqs = 0; + *in30 = *off; + write rnosub; + else; + exsr fillList; + *in30 = *on; + endif; + + write rlfoot; + *in40 = *off; + if msgrrn > 0; + *in40 = *on; + endif; + write rmsgctl; + exfmt asctl; + + if *in03 or *in12; + leave; + endif; + + if *in05; + iter; + endif; + + // Fully drain the READC loop before switching to the detail record -- + // matches perpselr.sqlrpgle's "collect then act" pattern for one + // action per Enter. + if numReqs > 0; + selRrn = 0; + selOpt = ' '; + reviewRrn = 0; + readc asfl; + dow not %eof(reqaprd); + if asopt <> ''; + selRrn = rrn; + selOpt = asopt; + if selOpt = '5'; + if reviewRrn = 0; + reviewRrn = selRrn; + else; + // Queued mid-readc, before this pass's own exfmt already + // happened -- must survive one more full loop pass before + // clearMsgs wipes it, or it never reaches the screen. + writeMsg('Only one requisition may be reviewed per Enter.'); + holdMsg = *on; + endif; + else; + writeMsg('Option ' + selOpt + ' not valid - use 5.'); + holdMsg = *on; + endif; + selRrn = 0; + endif; + readc asfl; + enddo; + + if reviewRrn > 0 and msgrrn = 0; + selReqnbr = reqs(reviewRrn).reqnbr; + exsr reviewReq; + endif; + endif; + +enddo; + +*inlr = *on; +return; + +// --------------------------------------------------------------------- +begsr loadReqs; + numReqs = 0; + exec sql declare c1 cursor for + select requisition_number, requested_by, need_by_date, priority_code, + total_estimated_cost, confidence_pct + from perpdemo.requisition_header + where company_code = :compcd and status_code = 'SUBMITTED' + order by requisition_number; + exec sql open c1; + if sqlcode < 0; + writeMsg('SQL open failed: SQLCODE=' + %char(sqlcode)); + leavesr; + endif; + + dow numReqs < %elem(reqs); + exec sql fetch c1 into :reqRow.reqnbr, :reqRow.reqby, :reqRow.needby, + :reqRow.pricd, :reqRow.totest, + :confPct :confInd; + if sqlcode = 100 or sqlcode < 0; + leave; + endif; + if confInd < 0; + reqRow.conf = 'N/A'; + else; + reqRow.conf = %char(confPct) + '%'; + endif; + numReqs += 1; + reqs(numReqs) = reqRow; + enddo; + exec sql close c1; +endsr; + +// --------------------------------------------------------------------- +begsr fillList; + rrn = 0; + *in31 = *on; + write asctl; + *in31 = *off; + for i = 1 to numReqs; + asopt = ''; + asreqnbr = %char(reqs(i).reqnbr); + asreqby = reqs(i).reqby; + asneedby = reqs(i).needby; + aspricd = reqs(i).pricd; + astotest = reqs(i).totest; + asconf = reqs(i).conf; + rrn += 1; + write asfl; + endfor; +endsr; + +// --------------------------------------------------------------------- +begsr reviewReq; + ddreqnbr = %char(selReqnbr); + ddreqby = reqs(reviewRrn).reqby; + ddneedby = reqs(reviewRrn).needby; + ddpricd = reqs(reviewRrn).pricd; + ddtotest = reqs(reviewRrn).totest; + ddconf = reqs(reviewRrn).conf; + enotes2 = ''; + + exsr loadLines2; + exsr fillDetailLines; + + dow '1'; + // PERP-87: same holdMsg pattern as the outer list loop -- an + // Approve/Reject SQL-failure message queued below must survive + // one pass before being wiped by clearMsgs. + if holdMsg; + holdMsg = *off; + else; + exsr clearMsgs; + endif; + if msgrrn > 0; + *in40 = *on; + else; + *in40 = *off; + endif; + write rmsgctl; + exfmt rdetail; + + // PERP-87: response indicators are program-level, not + // format-level -- RPG does not automatically turn them back off + // between EXFMTs to different record formats sharing this device + // file. Leaving *in06/*in07/*in12 ON here would make the OUTER + // list loop's own "if *in03 or *in12" check (evaluated right + // after its NEXT exfmt asctl, before the user has pressed + // anything on that screen) fire immediately, ending the whole + // program and looking exactly like "F6/F7/F12 kick back to the + // menu" -- reset all three explicitly on every path out of here. + if *in12; + *in06 = *off; + *in07 = *off; + *in12 = *off; + leavesr; + endif; + + if *in06; + exec sql + update perpdemo.requisition_header + set status_code = 'APPROVED', + approved_by = user, + approved_at = current_timestamp, + approval_source_code = 'HUMAN', + approval_source_type = 'APPRSRC', + approval_notes = :enotes2, + updated_at = current_timestamp, + updated_by = user + where company_code = :compcd and requisition_number = :selReqnbr; + *in06 = *off; + if sqlcode < 0; + writeMsg('Approve failed: SQLCODE=' + %char(sqlcode)); + holdMsg = *on; + iter; + endif; + writeMsg('Requisition ' + %trim(ddreqnbr) + ' approved.'); + holdMsg = *on; + *in07 = *off; + *in12 = *off; + leavesr; + endif; + + if *in07; + exec sql + update perpdemo.requisition_header + set status_code = 'REJECTED', + approved_by = user, + approved_at = current_timestamp, + approval_source_code = 'HUMAN', + approval_source_type = 'APPRSRC', + approval_notes = :enotes2, + updated_at = current_timestamp, + updated_by = user + where company_code = :compcd and requisition_number = :selReqnbr; + *in07 = *off; + if sqlcode < 0; + writeMsg('Reject failed: SQLCODE=' + %char(sqlcode)); + holdMsg = *on; + iter; + endif; + writeMsg('Requisition ' + %trim(ddreqnbr) + ' rejected.'); + holdMsg = *on; + *in06 = *off; + *in12 = *off; + leavesr; + endif; + + iter; + enddo; +endsr; + +// --------------------------------------------------------------------- +begsr loadLines2; + numLines = 0; + exec sql declare c2 cursor for + select item_number, quantity, uom_code, est_unit_cost + from perpdemo.requisition_line + where company_code = :compcd and requisition_number = :selReqnbr + order by line_number; + exec sql open c2; + if sqlcode < 0; + writeMsg('SQL open failed: SQLCODE=' + %char(sqlcode)); + leavesr; + endif; + + dow numLines < %elem(detailLines); + exec sql fetch c2 into :lineRow2; + if sqlcode = 100 or sqlcode < 0; + leave; + endif; + numLines += 1; + detailLines(numLines) = lineRow2; + enddo; + exec sql close c2; +endsr; + +// --------------------------------------------------------------------- +// Fills the fixed L1..L6 (item/qty/uom/cost) plain fields on RDETAIL from +// detailLines(). Each row's 4 fields are conditioned in the DDS on its +// own indicator (*in60..*in65) so an unused row is truly blank on screen +// -- not just zeroed-out numerics, which display as "0.0000" per +// EDTCDE(3) and read as confusing garbage data rather than "no line +// here." Also turns on *in34 (conditions the "more lines exist" message) +// when numLines exceeds what the screen can show. +begsr fillDetailLines; + if numLines > MAXDTLLINES; + *in34 = *on; + else; + *in34 = *off; + endif; + + *in60 = (numLines >= 1); + *in61 = (numLines >= 2); + *in62 = (numLines >= 3); + *in63 = (numLines >= 4); + *in64 = (numLines >= 5); + *in65 = (numLines >= 6); + + if numLines >= 1; + l1item = detailLines(1).item; + l1qty = detailLines(1).qty; + l1uom = detailLines(1).uom; + l1cost = detailLines(1).cost; + endif; + + if numLines >= 2; + l2item = detailLines(2).item; + l2qty = detailLines(2).qty; + l2uom = detailLines(2).uom; + l2cost = detailLines(2).cost; + endif; + + if numLines >= 3; + l3item = detailLines(3).item; + l3qty = detailLines(3).qty; + l3uom = detailLines(3).uom; + l3cost = detailLines(3).cost; + endif; + + if numLines >= 4; + l4item = detailLines(4).item; + l4qty = detailLines(4).qty; + l4uom = detailLines(4).uom; + l4cost = detailLines(4).cost; + endif; + + if numLines >= 5; + l5item = detailLines(5).item; + l5qty = detailLines(5).qty; + l5uom = detailLines(5).uom; + l5cost = detailLines(5).cost; + endif; + + if numLines >= 6; + l6item = detailLines(6).item; + l6qty = detailLines(6).qty; + l6uom = detailLines(6).uom; + l6cost = detailLines(6).cost; + endif; +endsr; + +// --------------------------------------------------------------------- +begsr clearMsgs; + msgrrn = 0; + *in41 = *on; + write rmsgctl; + *in41 = *off; +endsr; + +// --------------------------------------------------------------------- +dcl-proc writeMsg; + dcl-pi *n; + text varchar(256) const; + end-pi; + dcl-s data char(256); + data = text; + QMHSNDPM( + 'CPF9897' : + 'QCPFMSG QSYS ' : + data : + %len(text) : + '*INFO ' : + '* ' : + 1 : + smsgkey : + x'0000000000000000'); + msgrrn += 1; + spgmq = statusDS.programName; + write rmsgsfl; +end-proc; diff --git a/perp/qrpglesrc/reqauto.sqlrpgle b/perp/qrpglesrc/reqauto.sqlrpgle new file mode 100644 index 00000000..342e4dee --- /dev/null +++ b/perp/qrpglesrc/reqauto.sqlrpgle @@ -0,0 +1,154 @@ +**free + +// --------------------------------------------------------------------- +// Module: reqauto (CoderFlow auto-approval hook) +// Purpose: See reqauto_pr.rpgle for the exported procedure contracts. +// Callers commit/rollback the unit-of-work; this module never +// issues COMMIT/ROLLBACK (DDL_STYLE_GUIDE.md Sec.13). +// Epic: PERP-6 (PERP-36) +// --------------------------------------------------------------------- + +ctl-opt nomain; + +exec sql set option closqlcsr = *endmod; + +/copy reqauto_pr.rpgle + +// --------------------------------------------------------------------- +// Host-variable naming: prefixed per subprocedure (sc_/ev_) so the +// SQLRPGLE precompiler's module-wide (not subprocedure-scoped) host +// variable collection doesn't raise SQL0314 (DDL_STYLE_GUIDE.md Sec.13). +// --------------------------------------------------------------------- + +// reqauto_score — no-op placeholder scorer (see prototype for contract). +dcl-proc reqauto_score export; + dcl-pi *n packed(5:2); + sc_company char(3) const; + sc_reqnbr int(20) const; + sc_errmsg varchar(80); + end-pi; + + dcl-s sc_cnt int(10); + + sc_errmsg = ''; + + exec sql + select count(*) into :sc_cnt + from perpdemo.requisition_header + where company_code = :sc_company and requisition_number = :sc_reqnbr; + if sc_cnt = 0; + sc_errmsg = 'reqauto_score: requisition not found'; + return -1; + endif; + + // Placeholder score. Not a function of the requisition's content -- + // a real CoderFlow scoring call will replace this body. Chosen high + // enough to clear the demo's default 85% threshold so the happy path + // is exercisable end-to-end before real scoring exists. + return 92.50; + +end-proc; + +// reqauto_evaluate — score + conditionally auto-approve (see prototype). +dcl-proc reqauto_evaluate export; + dcl-pi *n int(10); + ev_company char(3) const; + ev_reqnbr int(20) const; + ev_errmsg varchar(80); + end-pi; + + dcl-s ev_status varchar(20); + dcl-s ev_total packed(15:2); + dcl-s ev_conf packed(5:2); + dcl-s ev_thresh packed(5:2); + dcl-s ev_maxamt packed(15:2); + dcl-s ev_thrTxt varchar(256); + dcl-s ev_maxTxt varchar(256); + dcl-s ev_notes varchar(500); + + ev_errmsg = ''; + + exec sql + select status_code, total_estimated_cost + into :ev_status, :ev_total + from perpdemo.requisition_header + where company_code = :ev_company and requisition_number = :ev_reqnbr; + if sqlcode <> 0; + ev_errmsg = 'reqauto_evaluate: requisition not found'; + return -1; + endif; + + if ev_status <> 'SUBMITTED'; + ev_errmsg = 'reqauto_evaluate: status is ' + %trim(ev_status) + + ', expected SUBMITTED'; + return -1; + endif; + + ev_conf = reqauto_score(ev_company : ev_reqnbr : ev_errmsg); + if ev_conf < 0; + return -1; + endif; + + exec sql + update perpdemo.requisition_header + set confidence_pct = :ev_conf, + updated_at = current_timestamp, + updated_by = user + where company_code = :ev_company and requisition_number = :ev_reqnbr; + if sqlcode < 0; + ev_errmsg = 'reqauto_evaluate: confidence_pct update failed SQLCODE=' + + %char(sqlcode); + return -1; + endif; + + exec sql + select config_value into :ev_thrTxt + from perpdemo.company_config + where company_code = :ev_company + and config_key = 'approval.auto_threshold'; + if sqlcode <> 0; + ev_errmsg = 'reqauto_evaluate: approval.auto_threshold not configured'; + return -1; + endif; + + exec sql + select config_value into :ev_maxTxt + from perpdemo.company_config + where company_code = :ev_company + and config_key = 'approval.auto_max_amount'; + if sqlcode <> 0; + ev_errmsg = 'reqauto_evaluate: approval.auto_max_amount not configured'; + return -1; + endif; + + ev_thresh = %dec(%trim(ev_thrTxt) : 5 : 2); + ev_maxamt = %dec(%trim(ev_maxTxt) : 15 : 2); + + if ev_conf >= ev_thresh and ev_total <= ev_maxamt; + // Placeholder explanation -- a real confidence rationale string + // will come from CoderFlow once real scoring lands. + ev_notes = 'Auto-approved by CoderFlow: confidence ' + %char(ev_conf) + + '% >= threshold ' + %char(ev_thresh) + '%, total ' + + %char(ev_total) + ' <= max ' + %char(ev_maxamt) + '.'; + exec sql + update perpdemo.requisition_header + set status_code = 'APPROVED', + approved_by = 'CODERFLOW', + approved_at = current_timestamp, + approval_source_code = 'CODERFLOW', + approval_source_type = 'APPRSRC', + approval_notes = :ev_notes, + updated_at = current_timestamp, + updated_by = user + where company_code = :ev_company and requisition_number = :ev_reqnbr; + if sqlcode < 0; + ev_errmsg = 'reqauto_evaluate: auto-approve update failed SQLCODE=' + + %char(sqlcode); + return -1; + endif; + return 1; + endif; + + return 0; + +end-proc; diff --git a/perp/qrpglesrc/reqauto_pr.rpgle b/perp/qrpglesrc/reqauto_pr.rpgle new file mode 100644 index 00000000..b36bd891 --- /dev/null +++ b/perp/qrpglesrc/reqauto_pr.rpgle @@ -0,0 +1,40 @@ +**free + +// --------------------------------------------------------------------- +// Prototypes: reqauto (CoderFlow auto-approval hook) +// Module: perp +// Purpose: Integration point for CoderFlow. Scores a submitted +// requisition and auto-approves it when the score and +// total both pass the company's configured thresholds. +// Epic: PERP-6 (PERP-36) +// --------------------------------------------------------------------- + +// reqauto_score — no-op placeholder scorer. Returns a fixed confidence_pct +// (0-100) for the given requisition. Today this is a stand-in for the +// real CoderFlow scoring call that will replace it; it does not inspect +// the requisition's content. Returns -1 and fills errmsg if the +// requisition is not found. +dcl-pr reqauto_score packed(5:2); + company char(3) const; + reqnbr int(20) const; + errmsg varchar(80); +end-pr; + +// reqauto_evaluate — score a requisition and auto-approve it if the score +// exceeds company_config('approval.auto_threshold') AND +// total_estimated_cost is under company_config('approval.auto_max_amount'). +// Always writes confidence_pct back to the requisition, whether or not +// it clears the bar. On auto-approval, stamps approved_by='CODERFLOW', +// approved_at=now, approval_source_code='CODERFLOW', and a placeholder +// approval_notes explanation (a real explanation string will come from +// CoderFlow later). +// +// Returns: 1 = auto-approved +// 0 = scored but not auto-approved (stays SUBMITTED) +// -1 = error (requisition not found, missing config, or a +// non-DRAFT/SUBMITTED status); errmsg is filled +dcl-pr reqauto_evaluate int(10); + company char(3) const; + reqnbr int(20) const; + errmsg varchar(80); +end-pr; diff --git a/perp/qrpglesrc/reqautosmk.sqlrpgle b/perp/qrpglesrc/reqautosmk.sqlrpgle new file mode 100644 index 00000000..9bf5f900 --- /dev/null +++ b/perp/qrpglesrc/reqautosmk.sqlrpgle @@ -0,0 +1,77 @@ +**free + +// --------------------------------------------------------------------- +// Program: reqautosmk (reqauto smoke test) +// Purpose: One-shot caller that exercises reqauto_evaluate against a +// real requisition so a joblog + interactive session confirms +// the service program is bound correctly. +// Meant to be CALLed once from an interactive session: +// CALL PGM(PERPDEMO/REQAUTOSMK) PARM('ACM' '3 ') +// (requisition 3 must exist and be status SUBMITTED). The +// requisition number parameter is CHAR(8), not numeric -- raw +// CALL/PARM (no *CMD definition, no RPG prototype on the +// caller's side) sends exactly the literal's own length with +// no padding to the receiver's declared size, so the literal +// MUST be padded to exactly 8 characters (trailing blanks) or +// the receiver reads past the passed argument (RNX0105 at +// runtime, confirmed PERP-36 -- an unquoted numeric literal or +// an unpadded quoted one both corrupt the value silently/ +// fatally rather than raising a friendly error). +// Epic: PERP-6 (PERP-36) +// --------------------------------------------------------------------- + +ctl-opt dftactgrp(*no) actgrp(*new) bnddir('PERP'); + +/copy reqauto_pr.rpgle + +dcl-pr QMHSNDPM extpgm; + msgId char(7) const; + msgF char(20) const; + msgData char(256) const; + msgDataLen int(10) const; + msgType char(10) const; + stackEntry char(10) const; + stackCntr int(10) const; + msgKey char(4); + errorCode char(8) const; +end-pr; + +dcl-pi *n; + p_company char(3); + p_reqnbr char(8); +end-pi; + +dcl-s errmsg varchar(80); +dcl-s result int(10); +dcl-s reqnbr int(20); +dcl-s line char(256); +dcl-s msgkey char(4); + +reqnbr = %dec(%trim(p_reqnbr) : 20 : 0); +result = reqauto_evaluate(p_company : reqnbr : errmsg); +line = 'reqauto_evaluate(' + %trim(p_company) + ',' + %char(reqnbr) + + ') = ' + %char(result) + ' err=' + errmsg; +callMsg(line); + +exec sql commit; + +*inlr = *on; +return; + +dcl-proc callMsg; + dcl-pi *n; + text varchar(256) const; + end-pi; + dcl-s data char(256); + data = text; + QMHSNDPM( + 'CPF9897' : + 'QCPFMSG QSYS ' : + data : + %len(text) : + '*INFO ' : + '* ' : + 1 : + msgkey : + x'0000000000000000'); +end-proc; diff --git a/perp/qrpglesrc/reqentr.sqlrpgle b/perp/qrpglesrc/reqentr.sqlrpgle new file mode 100644 index 00000000..3a6fea67 --- /dev/null +++ b/perp/qrpglesrc/reqentr.sqlrpgle @@ -0,0 +1,594 @@ +**free + +// --------------------------------------------------------------------- +// Program: reqentr (Requisition Entry) +// Purpose: DSPF-based requisition entry, scoped by the company selected +// via perpselr (*LDA positions 1-3). Header screen collects +// requested_by/need_by/priority/notes, allocates the doc +// number via docseq_next('REQ'), then inserts a DRAFT header. +// Line screen is a subfile of requisition_line rows -- F6=Add +// opens an edit panel that defaults UOM from item and +// est_unit_cost from the item's preferred vendor price. +// F8=Submit requires >=1 line and flips status to SUBMITTED; +// no further changes are allowed once submitted. +// Epic: PERP-6 (PERP-34) +// --------------------------------------------------------------------- + +ctl-opt dftactgrp(*no) actgrp(*new) bnddir('PERP'); + +dcl-f reqentd workstn sfile(rlsfl:rrn) sfile(rmsgsfl:msgrrn); + +/copy docseq_pr.rpgle + +dcl-ds ldaDS dtaara(*lda) len(1024) qualified; + compcd char(3) pos(1); +end-ds; + +dcl-pr QMHSNDPM extpgm; + msgId char(7) const; + msgF char(20) const; + msgData char(256) const; + msgDataLen int(10) const; + msgType char(10) const; + stackEntry char(10) const; + stackCntr int(10) const; + msgKey char(4); + errorCode char(8) const; +end-pr; + +// Standard, reusable Item Number prompt (PERP-51/PERP-56). Same dynamic +// CALL idiom as wrkitmr's callWrkcnvr/callWrklotr. +dcl-pr callItmprmt extpgm('ITMPRMT'); + pCompcd char(3) const; + pItem varchar(25); +end-pr; + +dcl-ds statusDS psds qualified; + programName char(10) pos(334); +end-ds; + +dcl-ds lineRow qualified; + lnbr int(10); + item varchar(25); + qty packed(15:4); + uom varchar(5); + cost packed(15:4); +end-ds; + +dcl-ds rows likeds(lineRow) dim(500); +dcl-s numRows int(10); +dcl-s i int(10); +dcl-s rrn int(10); +dcl-s msgrrn int(10); +dcl-s selRrn int(10); +dcl-s changeRrn int(10); +dcl-s selOpt char(1); +dcl-s compcd char(3); +dcl-s reqnbr int(20); +dcl-s docerrmsg varchar(80); +dcl-s reqStatus varchar(20); +dcl-s nextLine int(10); +dcl-s chgLnbr int(10); +dcl-s cnt int(10); +dcl-s edefuom varchar(5); +dcl-s edefcost packed(15:4); +dcl-s edesc varchar(60); +dcl-s promptItem varchar(25); +dcl-s doneAll ind; +dcl-s holdMsg ind; + +in ldaDS; +compcd = ldaDS.compcd; + +if compcd = ''; + exsr clearMsgs; + writeMsg('No company selected - run Select Company (PERPSELR) first.'); + *in40 = *on; + write rmsgctl; + hcompdsp = ''; + exfmt rhead; + *inlr = *on; + return; +endif; + +hcompdsp = compcd; + +// ----------------------------------------------------------------------- +// Header entry -- collect requested_by/need_by/priority/notes, validate, +// allocate the doc number, insert the DRAFT header. Wrapped in an outer +// loop (PERP-86) so a successful F8=Submit on the line screen below +// returns here for the NEXT requisition instead of leaving the user +// stranded on the now-read-only submitted line list. +// ----------------------------------------------------------------------- +doneAll = *off; + +dow not doneAll; + // PERP-76: default Requested By to the current job user, but only when + // that job user is actually a known perp_user -- an interactive/SSH job + // user (e.g. AIDEMO) will almost never be one, and pre-filling with a + // value that then fails the "not found" check below just traded a blank + // required field for a confusing default the human has to notice and + // overwrite anyway. Leaving it blank keeps the existing, already-clear + // "Requested By is required" prompt as the fallback. + exec sql values(user) into :hreqby; + exec sql + select count(*) into :cnt + from perpdemo.perp_user + where user_code = :hreqby; + if cnt = 0; + hreqby = ''; + endif; + hneedby = %date() + %days(7); + hpricd = 'NORMAL'; + hnotes = ''; + + // PERP-86: a submit confirmation queued just before restarting this + // loop must survive one pass before clearMsgs wipes it -- same + // holdMsg pattern as PERP-74/PERP-87. + if holdMsg; + holdMsg = *off; + else; + exsr clearMsgs; + endif; + + dow '1'; + *in40 = *off; + if msgrrn > 0; + *in40 = *on; + endif; + write rmsgctl; + exfmt rhead; + + if *in03 or *in12; + *inlr = *on; + return; + endif; + + exsr clearMsgs; + + if %trim(hreqby) = ''; + writeMsg('Requested By is required.'); + iter; + endif; + + exec sql + select count(*) into :cnt + from perpdemo.perp_user + where user_code = :hreqby; + if cnt = 0; + writeMsg('Requested By ' + %trim(hreqby) + ' not found.'); + iter; + endif; + + if %trim(hpricd) = ''; + hpricd = 'NORMAL'; + endif; + + exec sql + select count(*) into :cnt + from perpdemo.code_master + where code_type = 'PRIORITY' and code_value = :hpricd; + if cnt = 0; + writeMsg('Priority ' + %trim(hpricd) + ' not valid.'); + iter; + endif; + + leave; +enddo; + +reqnbr = docseq_next(compcd : 'REQ' : docerrmsg); +if reqnbr = 0; + writeMsg('Could not allocate requisition number: ' + docerrmsg); + *inlr = *on; + return; +endif; + +exec sql + insert into perpdemo.requisition_header + (company_code, requisition_number, requested_by, need_by_date, + priority_code, notes) + values (:compcd, :reqnbr, :hreqby, :hneedby, :hpricd, :hnotes); +if sqlcode < 0; + writeMsg('Could not create requisition: SQLCODE=' + %char(sqlcode)); + *inlr = *on; + return; +endif; + +// ----------------------------------------------------------------------- +// Line entry -- subfile of requisition_line rows. +// ----------------------------------------------------------------------- +exsr clearMsgs; +writeMsg('Requisition ' + %char(reqnbr) + ' created (DRAFT). Add lines, ' + + 'then F8=Submit.'); + +dow '1'; + exsr loadHeader; + exsr loadLines; + + if numRows = 0; + *in30 = *off; + write rnolin; + else; + exsr fillSubfile; + *in30 = *on; + endif; + + write rlfoot; + *in40 = *off; + if msgrrn > 0; + *in40 = *on; + endif; + write rmsgctl; + exfmt rlctl; + + // PERP-85: F3 exits the program; F12 must NOT -- it should just step + // back to (redisplay) this line list rather than ending the whole + // flow. The requisition header is already committed at this point, + // so there's no earlier screen to unwind into. + if *in03; + doneAll = *on; + leave; + endif; + if *in12; + iter; + endif; + + exsr clearMsgs; + + if *in06; + if reqStatus <> 'DRAFT'; + writeMsg('Requisition already submitted - no further changes allowed.'); + else; + exsr addLine; + endif; + iter; + endif; + + if *in08; + if numRows = 0; + writeMsg('At least one line is required before submitting.'); + elseif reqStatus <> 'DRAFT'; + writeMsg('Requisition already submitted.'); + else; + exec sql + update perpdemo.requisition_header + set status_code = 'SUBMITTED', + updated_at = current_timestamp, + updated_by = user + where company_code = :compcd and requisition_number = :reqnbr; + if sqlcode < 0; + writeMsg('Submit failed: SQLCODE=' + %char(sqlcode)); + else; + // PERP-86: return to a fresh header entry screen for the next + // requisition instead of staying parked on this now read-only + // line list. holdMsg carries this confirmation through to the + // restarted header loop above. + writeMsg('Requisition ' + %char(reqnbr) + ' submitted.'); + holdMsg = *on; + leave; + endif; + endif; + iter; + endif; + + // Fully drain the READC loop before switching to RLEDIT for a change + // (option 2). Calling changeLine in-line here -- while a READC cursor + // is still active on RLSFL -- disturbs the subfile's pending read + // sequence on this same device file, and the next readc raises + // CPF5006 ("Session or device error occurred in file REQENTD"). Same + // fix as PERPSELR/REQAPRR: collect the row to change while draining + // (deletes and invalid-option messages don't switch formats, so they + // still run in-line), act on the change only after the loop finishes + // (DDL_STYLE_GUIDE.md Sec.14). + if numRows > 0; + selRrn = 0; + selOpt = ' '; + changeRrn = 0; + readc rlsfl; + dow not %eof(reqentd); + if slopt <> ''; + selRrn = rrn; + selOpt = slopt; + exsr handleOpt; + selRrn = 0; + endif; + readc rlsfl; + enddo; + + if changeRrn > 0 and msgrrn = 0; + selRrn = changeRrn; + exsr changeLine; + endif; + endif; + + enddo; +enddo; + +*inlr = *on; +return; + +// --------------------------------------------------------------------- +begsr loadHeader; + exec sql + select status_code, requested_by, need_by_date, priority_code, + total_estimated_cost + into :reqStatus, :dreqby, :dneedby, :dpricd, :dtotest + from perpdemo.requisition_header + where company_code = :compcd and requisition_number = :reqnbr; + dreqnbr = %char(reqnbr); + dstatus = reqStatus; +endsr; + +// --------------------------------------------------------------------- +begsr loadLines; + numRows = 0; + exec sql declare c1 cursor for + select line_number, item_number, quantity, uom_code, est_unit_cost + from perpdemo.requisition_line + where company_code = :compcd and requisition_number = :reqnbr + order by line_number; + exec sql open c1; + if sqlcode < 0; + writeMsg('SQL open failed: SQLCODE=' + %char(sqlcode)); + leavesr; + endif; + + dow numRows < %elem(rows); + exec sql fetch c1 into :lineRow.lnbr, :lineRow.item, :lineRow.qty, + :lineRow.uom, :lineRow.cost; + if sqlcode = 100 or sqlcode < 0; + leave; + endif; + numRows += 1; + rows(numRows) = lineRow; + enddo; + exec sql close c1; +endsr; + +// --------------------------------------------------------------------- +begsr fillSubfile; + rrn = 0; + *in31 = *on; + write rlctl; + *in31 = *off; + for i = 1 to numRows; + slopt = ''; + slline = rows(i).lnbr; + slitem = rows(i).item; + slqty = rows(i).qty; + sluom = rows(i).uom; + slcost = rows(i).cost; + rrn += 1; + write rlsfl; + endfor; +endsr; + +// --------------------------------------------------------------------- +begsr handleOpt; + chain selRrn rlsfl; + if %found(reqentd); + if reqStatus <> 'DRAFT'; + writeMsg('Requisition already submitted - no further changes allowed.'); + leavesr; + endif; + select; + when selOpt = '2'; + if changeRrn = 0; + changeRrn = selRrn; + else; + writeMsg('Only one line may be changed per Enter.'); + endif; + when selOpt = '4'; + exsr deleteLine; + other; + writeMsg('Option ' + selOpt + ' not valid.'); + endsl; + endif; +endsr; + +// --------------------------------------------------------------------- +begsr addLine; + emode = 'A'; + eitem = ''; + eqty = 0; + euom = ''; + ecost = 0; + + dow '1'; + exfmt rledit; + if *in12; + leavesr; + endif; + + // Item Number prompt (PERP-61): '?' + Enter invokes the standard + // reusable Item Number lookup (PERP-56) and returns the selection. + if %trim(eitem) = '?'; + promptItem = eitem; + callItmprmt(compcd : promptItem); + eitem = promptItem; + iter; + endif; + + if %trim(eitem) = ''; + writeMsg('Item Number is required.'); + iter; + endif; + + exec sql + select item_description, inventory_uom + into :edesc, :edefuom + from perpdemo.item + where company_code = :compcd and item_number = :eitem; + if sqlcode <> 0; + writeMsg('Item ' + %trim(eitem) + ' not found for this company.'); + iter; + endif; + + if eqty <= 0; + writeMsg('Quantity must be greater than zero.'); + iter; + endif; + + if %trim(euom) = ''; + euom = edefuom; + endif; + + if ecost = 0; + exec sql + select ivp.unit_price + into :edefcost + from perpdemo.item_vendor_price ivp + join perpdemo.item_vendor iv + on iv.company_code = ivp.company_code + and iv.item_number = ivp.item_number + and iv.vendor_code = ivp.vendor_code + where ivp.company_code = :compcd + and ivp.item_number = :eitem + and iv.is_preferred = 'Y' + and ivp.effective_to is null + fetch first 1 row only; + if sqlcode = 0; + ecost = edefcost; + endif; + endif; + + leave; + enddo; + + exec sql + select coalesce(max(line_number), 0) + 1 + into :nextLine + from perpdemo.requisition_line + where company_code = :compcd and requisition_number = :reqnbr; + + exec sql + insert into perpdemo.requisition_line + (company_code, requisition_number, line_number, item_number, + quantity, uom_code, est_unit_cost) + values (:compcd, :reqnbr, :nextLine, :eitem, :eqty, :euom, :ecost); + if sqlcode < 0; + writeMsg('Add line failed: SQLCODE=' + %char(sqlcode) + + ' SQLSTATE=' + sqlstate); + else; + writeMsg('Added line ' + %char(nextLine) + ': ' + %trim(edesc) + + ' (' + %trim(euom) + ' @ ' + %char(ecost) + ').'); + exsr recalcTotal; + endif; +endsr; + +// --------------------------------------------------------------------- +begsr changeLine; + // Read from the rows() snapshot (populated by loadLines), not the live + // RLSFL buffer -- changeLine now runs after the READC loop has fully + // drained (see the fix note above the readc loop), by which point the + // subfile buffer holds whatever row READC last visited, not + // necessarily this one. + chgLnbr = rows(selRrn).lnbr; + emode = 'C'; + eitem = rows(selRrn).item; + eqty = rows(selRrn).qty; + euom = rows(selRrn).uom; + ecost = rows(selRrn).cost; + + dow '1'; + exfmt rledit; + if *in12; + leavesr; + endif; + + // Item Number prompt (PERP-61): '?' + Enter invokes the standard + // reusable Item Number lookup (PERP-56) and returns the selection. + if %trim(eitem) = '?'; + promptItem = eitem; + callItmprmt(compcd : promptItem); + eitem = promptItem; + iter; + endif; + + leave; + enddo; + + if eqty <= 0; + writeMsg('Quantity must be greater than zero.'); + leavesr; + endif; + + if %trim(euom) = ''; + writeMsg('UOM is required.'); + leavesr; + endif; + + exec sql + update perpdemo.requisition_line + set quantity = :eqty, + uom_code = :euom, + est_unit_cost = :ecost, + updated_at = current_timestamp, + updated_by = user + where company_code = :compcd and requisition_number = :reqnbr + and line_number = :chgLnbr; + if sqlcode < 0; + writeMsg('Change failed: SQLCODE=' + %char(sqlcode)); + else; + writeMsg('Updated line ' + %char(chgLnbr) + '.'); + exsr recalcTotal; + endif; +endsr; + +// --------------------------------------------------------------------- +begsr deleteLine; + exec sql + delete from perpdemo.requisition_line + where company_code = :compcd and requisition_number = :reqnbr + and line_number = :slline; + if sqlcode < 0; + writeMsg('Delete failed: SQLSTATE=' + sqlstate); + else; + writeMsg('Deleted line ' + %char(slline) + '.'); + exsr recalcTotal; + endif; +endsr; + +// --------------------------------------------------------------------- +begsr recalcTotal; + exec sql + update perpdemo.requisition_header + set total_estimated_cost = + (select coalesce(sum(quantity * est_unit_cost), 0) + from perpdemo.requisition_line + where company_code = :compcd + and requisition_number = :reqnbr), + updated_at = current_timestamp, + updated_by = user + where company_code = :compcd and requisition_number = :reqnbr; +endsr; + +// --------------------------------------------------------------------- +begsr clearMsgs; + msgrrn = 0; + *in41 = *on; + write rmsgctl; + *in41 = *off; +endsr; + +// --------------------------------------------------------------------- +dcl-proc writeMsg; + dcl-pi *n; + text varchar(256) const; + end-pi; + dcl-s data char(256); + data = text; + QMHSNDPM( + 'CPF9897' : + 'QCPFMSG QSYS ' : + data : + %len(text) : + '*INFO ' : + '* ' : + 1 : + smsgkey : + x'0000000000000000'); + msgrrn += 1; + spgmq = statusDS.programName; + write rmsgsfl; +end-proc; diff --git a/perp/qrpglesrc/vndprmt.sqlrpgle b/perp/qrpglesrc/vndprmt.sqlrpgle new file mode 100644 index 00000000..7fa7e0f1 --- /dev/null +++ b/perp/qrpglesrc/vndprmt.sqlrpgle @@ -0,0 +1,204 @@ +**free + +// --------------------------------------------------------------------- +// Program: vndprmt (standard, reusable Vendor Number prompt/lookup) +// Purpose: Companion to itmprmt (PERP-56). System-wide "?" + Enter +// lookup for any keyable Vendor field. Same calling +// convention: caller CALLs this program passing the company +// code and the field's current value; '?' (or blank) lists +// all vendors, any other seed pre-fills the Search field. +// Subfile lists vendor_code + vendor_name, filtered +// case-insensitively on either column; 1=Select on a row +// returns that vendor_code. F3/F12 cancel and return the +// field blank. Called via a plain dynamic CALL (EXTPGM +// prototype declared in each caller), same idiom as itmprmt. +// Callers: wrkivnr (PERP-71). +// Epic: PERP-51 (PERP-70) +// --------------------------------------------------------------------- + +ctl-opt dftactgrp(*no) actgrp(*new); + +dcl-pi *n; + pCompcd char(3) const; + pVendor varchar(10); +end-pi; + +dcl-f vndprmtd workstn sfile(vpsfl:rrn) sfile(vpmsgsfl:msgrrn); + +dcl-pr QMHSNDPM extpgm; + msgId char(7) const; + msgF char(20) const; + msgData char(256) const; + msgDataLen int(10) const; + msgType char(10) const; + stackEntry char(10) const; + stackCntr int(10) const; + msgKey char(4); + errorCode char(8) const; +end-pr; + +dcl-ds statusDS psds qualified; + programName char(10) pos(334); +end-ds; + +dcl-ds vendorRow qualified; + vendor varchar(10); + name varchar(60); +end-ds; + +dcl-ds rows likeds(vendorRow) dim(500); +dcl-s numRows int(10); +dcl-s i int(10); +dcl-s rrn int(10); +dcl-s msgrrn int(10); +dcl-s msgkey char(4); +dcl-s selRrn int(10); +dcl-s search varchar(30); + +search = %trim(pVendor); +if search = '?'; + search = ''; +endif; +ssearch = search; + +dow not *in03 and not *in12; + exsr clearMsgs; + exsr loadRows; + + if numRows = 0; + *in30 = *off; + write vpnone; + else; + exsr fillSubfile; + *in30 = *on; + endif; + + write vpfoot; + if msgrrn > 0; + *in40 = *on; + write vpmsgctl; + else; + *in40 = *off; + endif; + + exfmt vpctl; + + if *in03 or *in12; + pVendor = ''; + leave; + endif; + + if *in05; + iter; + endif; + + if ssearch <> search; + search = %trim(ssearch); + iter; + endif; + + // Guard on numRows: READC against a subfile that was never written + // to this cycle (0 rows loaded) raises a "Session or device error" + // (CPF5006-class) runtime error instead of just returning *EOF. + if numRows > 0; + selRrn = 0; + readc vpsfl; + dow not %eof(vndprmtd); + if sopt = '1'; + if selRrn = 0; + selRrn = rrn; + else; + writeMsg('Only one vendor may be selected per Enter.'); + endif; + elseif sopt <> ''; + writeMsg('Option ' + sopt + ' is not valid - use 1.'); + endif; + readc vpsfl; + enddo; + endif; + + if selRrn > 0 and msgrrn = 0; + chain selRrn vpsfl; + pVendor = sivendor; + leave; + endif; + +enddo; + +*inlr = *on; +return; + +// --------------------------------------------------------------------- +begsr loadRows; + numRows = 0; + exec sql declare vp1 cursor for + select vendor_code, vendor_name + from perpdemo.vendor + where company_code = :pCompcd + and (:search = '' + or upper(vendor_code) like '%' || upper(:search) || '%' + or upper(vendor_name) like '%' || upper(:search) || '%') + order by vendor_code; + exec sql open vp1; + if sqlcode < 0; + writeMsg('SQL open failed: SQLCODE=' + %char(sqlcode)); + leavesr; + endif; + + dow numRows < %elem(rows); + exec sql fetch vp1 into :vendorRow; + if sqlcode = 100 or sqlcode < 0; + leave; + endif; + numRows += 1; + rows(numRows) = vendorRow; + enddo; + exec sql close vp1; +endsr; + +// --------------------------------------------------------------------- +begsr fillSubfile; + rrn = 0; + *in31 = *on; + write vpctl; + *in31 = *off; + for i = 1 to numRows; + *in50 = *off; + *in51 = *off; + sopt = ''; + sivendor = rows(i).vendor; + sivname = rows(i).name; + rrn += 1; + write vpsfl; + endfor; +endsr; + +// --------------------------------------------------------------------- +begsr clearMsgs; + msgrrn = 0; + *in41 = *on; + write vpmsgctl; + *in41 = *off; +endsr; + +// --------------------------------------------------------------------- +dcl-proc writeMsg; + dcl-pi *n; + text varchar(256) const; + end-pi; + dcl-s data char(256); + data = text; + QMHSNDPM( + 'CPF9897' : + 'QCPFMSG QSYS ' : + data : + %len(text) : + '*INFO ' : + '* ' : + 1 : + smsgkey : + x'0000000000000000'); + msgrrn += 1; + spgmq = statusDS.programName; + write vpmsgsfl; +end-proc; diff --git a/perp/qrpglesrc/whcoord.sqlrpgle b/perp/qrpglesrc/whcoord.sqlrpgle new file mode 100644 index 00000000..44a2b192 --- /dev/null +++ b/perp/qrpglesrc/whcoord.sqlrpgle @@ -0,0 +1,165 @@ +**free + +// --------------------------------------------------------------------- +// Module: whcoord (warehouse coordinate query service) +// Purpose: Return every located item in a company joined with x/y/z +// coordinates computed from that company's warehouse_layout +// grid config. Data source for the future 3D map renderer. +// Epic: PERP-4 (3D Warehouse Map) / PERP-27 +// --------------------------------------------------------------------- + +ctl-opt nomain; + +// Real commitment control against PERPJRN -- per DDL_STYLE_GUIDE §7. +exec sql set option closqlcsr = *endmod; + +/copy whcoord_pr.rpgle + +// Module-scope: the company the cursor is open against, and that +// company's layout dims (cached at open time rather than re-queried +// per fetched row). +dcl-s g_company char(3); +dcl-s g_haslayout ind; +dcl-s g_binwid packed(9:4); +dcl-s g_binhgt packed(9:4); +dcl-s g_aslspc packed(9:4); + +// Only items with a fully-populated location are placed on the map -- +// see the design note in whcoord_pr.rpgle. Codes come back as-is (not +// CAST to INTEGER here) -- real seed data mixes a letter prefix with +// the ordinal (e.g. 'A1', 'B2', 'S3'), which CAST(... AS INTEGER) +// rejects outright (SQL0420). ordinalFromCode() below parses it. +exec sql declare whcoordcsr cursor for + select item_number, item_description, + aisle_code, bay_code, shelf_code, + qty_on_hand, qty_available + from perpdemo.item + where company_code = :g_company + and aisle_code <> '' + and bay_code <> '' + and shelf_code <> '' + order by item_number; + +// --------------------------------------------------------------------- +dcl-proc whcoord_open export; + dcl-pi *n ind; + oc_company char(3) const; + oc_errmsg varchar(80); + end-pi; + + oc_errmsg = ''; + g_company = oc_company; + g_haslayout = *off; + + exec sql + select bin_width_m, bin_height_m, aisle_spacing_m + into :g_binwid, :g_binhgt, :g_aslspc + from perpdemo.warehouse_layout + where company_code = :g_company; + if sqlcode = 0; + g_haslayout = *on; + endif; + + exec sql open whcoordcsr; + if sqlcode < 0; + oc_errmsg = 'whcoord_open: SQLCODE=' + %char(sqlcode) + + ' SQLSTATE=' + sqlstate; + return *off; + endif; + + return *on; +end-proc; + +// --------------------------------------------------------------------- +dcl-proc whcoord_fetch export; + dcl-pi *n ind; + fc_itemnbr varchar(25); + fc_itemdsc varchar(60); + fc_aisle int(10); + fc_bay int(10); + fc_shelf int(10); + fc_xm packed(9:4); + fc_ym packed(9:4); + fc_zm packed(9:4); + fc_onhand packed(15:4); + fc_avail packed(15:4); + fc_errmsg varchar(80); + end-pi; + + dcl-s aisleCode varchar(10); + dcl-s bayCode varchar(10); + dcl-s shelfCode varchar(10); + + fc_errmsg = ''; + + exec sql + fetch whcoordcsr into :fc_itemnbr, :fc_itemdsc, + :aisleCode, :bayCode, :shelfCode, + :fc_onhand, :fc_avail; + if sqlcode = 100; + return *off; + endif; + if sqlcode < 0; + fc_errmsg = 'whcoord_fetch: SQLCODE=' + %char(sqlcode) + + ' SQLSTATE=' + sqlstate; + return *off; + endif; + + // Ordinal 1 is the floor -- a code with no digits at all (shouldn't + // happen given the non-blank WHERE filter, but be defensive) still + // places the item at the grid origin rather than off in the + // negative direction. + fc_aisle = %max(1 : ordinalFromCode(aisleCode)); + fc_bay = %max(1 : ordinalFromCode(bayCode)); + fc_shelf = %max(1 : ordinalFromCode(shelfCode)); + + if g_haslayout; + fc_xm = (fc_bay - 1) * g_binwid; + fc_ym = (fc_aisle - 1) * g_aslspc; + fc_zm = (fc_shelf - 1) * g_binhgt; + else; + fc_xm = 0; + fc_ym = 0; + fc_zm = 0; + endif; + + return *on; +end-proc; + +// --------------------------------------------------------------------- +dcl-proc whcoord_close export; + dcl-pi *n ind; + end-pi; + + exec sql close whcoordcsr; + return *on; +end-proc; + +// --------------------------------------------------------------------- +// ordinalFromCode -- module-private. Pulls every digit character out +// of a location code (e.g. 'A1' -> 1, 'B12' -> 12) and returns it as +// an integer. Returns 0 if the code has no digits at all. +dcl-proc ordinalFromCode; + dcl-pi *n int(10); + code varchar(10) const; + end-pi; + + dcl-s i int(10); + dcl-s trimmed varchar(10); + dcl-s digits varchar(10); + dcl-s ch char(1); + + trimmed = %trim(code); + digits = ''; + for i = 1 to %len(trimmed); + ch = %subst(trimmed : i : 1); + if ch >= '0' and ch <= '9'; + digits += ch; + endif; + endfor; + + if digits = ''; + return 0; + endif; + return %int(digits); +end-proc; diff --git a/perp/qrpglesrc/whcoord_pr.rpgle b/perp/qrpglesrc/whcoord_pr.rpgle new file mode 100644 index 00000000..56fe9487 --- /dev/null +++ b/perp/qrpglesrc/whcoord_pr.rpgle @@ -0,0 +1,57 @@ +**free + +// --------------------------------------------------------------------- +// Prototypes: whcoord (warehouse coordinate query service) +// Module: perp +// Purpose: Iterator over located items in a company, with x/y/z +// coordinates derived from warehouse_layout. Data source +// for the (future RDF/EJS) 3D map renderer -- this story +// only delivers the queryable data. +// Epic: PERP-4 (3D Warehouse Map) / PERP-27 +// +// Usage: ok = whcoord_open(company : errmsg); +// dow whcoord_fetch(itemnbr : itemdsc : aisle : bay : shelf +// : xm : ym : zm : onhand : avail : errmsg); +// ... one row ... +// enddo; +// whcoord_close(); +// +// Design note: item.aisle_code/bay_code/shelf_code (PERP-3/PERP-20) are +// free-text VARCHAR(10) location codes, and real seed data mixes a +// letter prefix with the ordinal (e.g. 'A1', 'B2', 'S3' -- confirmed +// against the WIDGET1 seed row). CAST(... AS INTEGER) rejects that +// outright (SQL0420), so whcoord.sqlrpgle's private ordinalFromCode() +// pulls the digit characters out of each code instead of casting the +// whole string. Only items where all three codes are non-blank are +// returned -- unlocated items are simply not on the map yet. +// --------------------------------------------------------------------- + +// whcoord_open -- scope the iterator to one company. Also loads that +// company's warehouse_layout row (if any); if none exists yet, +// whcoord_fetch still enumerates items but returns x/y/z as 0. +// Returns *off on SQL error opening the cursor (errmsg carries detail). +dcl-pr whcoord_open ind; + company char(3) const; + errmsg varchar(80); +end-pr; + +// whcoord_fetch -- advance to the next located item. Returns *off at +// end of data or on error (errmsg carries 'SQLCODE=... SQLSTATE=...' +// in the error case; blank at normal end of data). +dcl-pr whcoord_fetch ind; + itemNumber varchar(25); + itemDescription varchar(60); + aisleOrdinal int(10); + bayOrdinal int(10); + shelfOrdinal int(10); + xMeters packed(9:4); + yMeters packed(9:4); + zMeters packed(9:4); + qtyOnHand packed(15:4); + qtyAvailable packed(15:4); + errmsg varchar(80); +end-pr; + +// whcoord_close -- close the cursor. Always returns *on. +dcl-pr whcoord_close ind; +end-pr; diff --git a/perp/qrpglesrc/whcoordsmk.sqlrpgle b/perp/qrpglesrc/whcoordsmk.sqlrpgle new file mode 100644 index 00000000..4b4f339d --- /dev/null +++ b/perp/qrpglesrc/whcoordsmk.sqlrpgle @@ -0,0 +1,94 @@ +**free + +// --------------------------------------------------------------------- +// Program: whcoordsmk (whcoord smoke test) +// Purpose: One-shot caller that exercises whcoord_open/fetch/close and +// prints each row via SNDPGMMSG so a joblog + interactive +// session confirms the service program is bound correctly. +// Meant to be CALLed once from an interactive session: +// CALL PGM(PERPDEMO/WHCOORDSMK) PARM('ACM') +// Epic: PERP-4 (3D Warehouse Map) / PERP-27 +// --------------------------------------------------------------------- + +ctl-opt dftactgrp(*no) actgrp(*new) bnddir('PERP'); + +/copy whcoord_pr.rpgle + +dcl-pr QMHSNDPM extpgm; + msgId char(7) const; + msgF char(20) const; + msgData char(256) const; + msgDataLen int(10) const; + msgType char(10) const; + stackEntry char(10) const; + stackCntr int(10) const; + msgKey char(4); + errorCode char(8) const; +end-pr; + +dcl-pi *n; + p_company char(3); +end-pi; + +dcl-s ok ind; +dcl-s itemnbr varchar(25); +dcl-s itemdsc varchar(60); +dcl-s aisle int(10); +dcl-s bay int(10); +dcl-s shelf int(10); +dcl-s xm packed(9:4); +dcl-s ym packed(9:4); +dcl-s zm packed(9:4); +dcl-s onhand packed(15:4); +dcl-s avail packed(15:4); +dcl-s errmsg varchar(80); +dcl-s numRows int(10); +dcl-s line char(256); +dcl-s msgkey char(4); + +numRows = 0; + +ok = whcoord_open(p_company : errmsg); +if not ok; + callMsg('whcoord_open failed for ' + %trim(p_company) + ': ' + errmsg); +else; + dow whcoord_fetch(itemnbr : itemdsc : aisle : bay : shelf : + xm : ym : zm : onhand : avail : errmsg); + numRows += 1; + line = %trim(itemnbr) + ' (' + %trim(itemdsc) + ') aisle=' + + %char(aisle) + ' bay=' + %char(bay) + ' shelf=' + %char(shelf) + + ' xyz=' + %char(xm) + ',' + %char(ym) + ',' + %char(zm) + + ' onhand=' + %char(onhand) + ' avail=' + %char(avail); + callMsg(line); + enddo; + + if errmsg <> ''; + callMsg('whcoord_fetch error: ' + errmsg); + endif; + + callMsg('whcoord: ' + %char(numRows) + ' row(s) for company ' + + %trim(p_company) + '.'); + + whcoord_close(); +endif; + +*inlr = *on; +return; + +dcl-proc callMsg; + dcl-pi *n; + text varchar(256) const; + end-pi; + dcl-s data char(256); + data = text; + QMHSNDPM( + 'CPF9897' : + 'QCPFMSG QSYS ' : + data : + %len(text) : + '*INFO ' : + '* ' : + 1 : + msgkey : + x'0000000000000000'); +end-proc; diff --git a/perp/qrpglesrc/wlmr.sqlrpgle b/perp/qrpglesrc/wlmr.sqlrpgle new file mode 100644 index 00000000..b0b31fa4 --- /dev/null +++ b/perp/qrpglesrc/wlmr.sqlrpgle @@ -0,0 +1,217 @@ +**free + +// --------------------------------------------------------------------- +// Program: wlmr (Warehouse Layout Maintenance) +// Purpose: Single-record display + edit of warehouse_layout -- one row +// per company, scoped by *LDA company_code (set by PERPSELR). +// Enter=Save (update if the row exists), F6=Add (insert the +// row the first time), F5=Refresh (discard in-progress edits +// and reload from DB), F12=Cancel (same as Refresh), F3=Exit. +// Epic: PERP-4 (3D Warehouse Map) / PERP-26 +// --------------------------------------------------------------------- + +ctl-opt dftactgrp(*no) actgrp(*new); + +dcl-f wlmd workstn sfile(wlmsgsfl:msgrrn); + +// Local Data Area -- perpselr stamps the selected company at pos 1-3. +dcl-ds ldaDS dtaara(*lda) len(1024) qualified; + compcd char(3) pos(1); +end-ds; + +dcl-pr QMHSNDPM extpgm; + msgId char(7) const; + msgF char(20) const; + msgData char(256) const; + msgDataLen int(10) const; + msgType char(10) const; + stackEntry char(10) const; + stackCntr int(10) const; + msgKey char(4); + errorCode char(8) const; +end-pr; + +dcl-ds statusDS psds qualified; + programName char(10) pos(334); +end-ds; + +dcl-s compcd char(3); +dcl-s exists ind; +dcl-s msgrrn int(10); +dcl-s holdMsg ind; + +in ldaDS; +compcd = ldaDS.compcd; + +if compcd = ''; + exsr clearMsgs; + writeMsg('No company selected - run Select Company (PERPSELR) first.'); +endif; + +dow not *in03 and not *in12; + if compcd = ''; + write wlnoco; + write wlfoot; + if msgrrn > 0; + *in40 = *on; + write wlmsgctl; + else; + *in40 = *off; + endif; + exfmt wledit; + leave; + endif; + + // A message queued by an action handler below (F6=Add) must survive + // one full loop pass before being cleared, or it never reaches the + // screen -- clearMsgs wipes msgrrn back to 0 on the very next pass, + // before this pass's own exfmt ever shows it. holdMsg skips exactly + // one clearMsgs call right after such a message was queued. Same + // pattern as wrkivpr (PERP-74). + if holdMsg; + holdMsg = *off; + else; + exsr clearMsgs; + endif; + exsr loadRow; + + write wlfoot; + if msgrrn > 0; + *in40 = *on; + write wlmsgctl; + else; + *in40 = *off; + endif; + exfmt wledit; + + if *in03 or *in12; + leave; + endif; + + if *in05; + iter; // refresh -- discard in-progress edits + endif; + + if *in06; + exsr addRow; + iter; + endif; + + // Enter -- save changes to the existing row. + if exists; + exsr updateRow; + else; + writeMsg('No row yet for company ' + %trim(compcd) + + ' - press F6=Add to create it.'); + endif; +enddo; + +*inlr = *on; +return; + +// --------------------------------------------------------------------- +begsr loadRow; + ecompc = compcd; + exec sql + select warehouse_name, aisle_count, bays_per_aisle, shelves_per_bay, + bin_width_m, bin_depth_m, bin_height_m, aisle_spacing_m, notes + into :ewhsnm, :easlcnt, :ebayspa, :eshlfsb, + :ebinwid, :ebindep, :ebinhgt, :easlspc, :enotes + from perpdemo.warehouse_layout + where company_code = :compcd; + + if sqlcode = 0; + exists = *on; + estat = 'EXISTING'; + else; + exists = *off; + estat = 'NEW'; + ewhsnm = ''; + easlcnt = 1; + ebayspa = 1; + eshlfsb = 1; + ebinwid = 1; + ebindep = 1; + ebinhgt = 1; + easlspc = 2; + enotes = ''; + endif; +endsr; + +// --------------------------------------------------------------------- +begsr addRow; + if exists; + writeMsg('Row already exists for company ' + %trim(compcd) + + ' - press Enter to save changes.'); + holdMsg = *on; + leavesr; + endif; + + exec sql + insert into perpdemo.warehouse_layout + (company_code, warehouse_name, aisle_count, bays_per_aisle, + shelves_per_bay, bin_width_m, bin_depth_m, bin_height_m, + aisle_spacing_m, notes) + values (:compcd, :ewhsnm, :easlcnt, :ebayspa, :eshlfsb, + :ebinwid, :ebindep, :ebinhgt, :easlspc, :enotes); + if sqlcode < 0; + writeMsg('Add failed: SQLCODE=' + %char(sqlcode) + + ' SQLSTATE=' + sqlstate); + else; + writeMsg('Warehouse layout created for company ' + %trim(compcd) + '.'); + endif; +endsr; + +// --------------------------------------------------------------------- +begsr updateRow; + exec sql + update perpdemo.warehouse_layout + set warehouse_name = :ewhsnm, + aisle_count = :easlcnt, + bays_per_aisle = :ebayspa, + shelves_per_bay = :eshlfsb, + bin_width_m = :ebinwid, + bin_depth_m = :ebindep, + bin_height_m = :ebinhgt, + aisle_spacing_m = :easlspc, + notes = :enotes, + updated_at = current_timestamp, + updated_by = user + where company_code = :compcd; + if sqlcode < 0; + writeMsg('Update failed: SQLCODE=' + %char(sqlcode) + + ' SQLSTATE=' + sqlstate); + else; + writeMsg('Warehouse layout updated for company ' + %trim(compcd) + '.'); + endif; +endsr; + +// --------------------------------------------------------------------- +begsr clearMsgs; + msgrrn = 0; + *in41 = *on; + write wlmsgctl; + *in41 = *off; +endsr; + +// --------------------------------------------------------------------- +dcl-proc writeMsg; + dcl-pi *n; + text varchar(256) const; + end-pi; + dcl-s data char(256); + data = text; + QMHSNDPM( + 'CPF9897' : + 'QCPFMSG QSYS ' : + data : + %len(text) : + '*INFO ' : + '* ' : + 1 : + smsgkey : + x'0000000000000000'); + msgrrn += 1; + spgmq = statusDS.programName; + write wlmsgsfl; +end-proc; diff --git a/perp/qrpglesrc/wrkcmr.sqlrpgle b/perp/qrpglesrc/wrkcmr.sqlrpgle new file mode 100644 index 00000000..d6fb1722 --- /dev/null +++ b/perp/qrpglesrc/wrkcmr.sqlrpgle @@ -0,0 +1,369 @@ +**free + +// --------------------------------------------------------------------- +// Program: wrkcmr (Work with Code Master) +// Purpose: DSPF-based CRUD for the code_master table. One screen shows +// all system lookups regardless of code_type; a filter field +// narrows the subfile to a specific type. Options 2/4/5 +// change/delete/display; F6 adds. Delete falls through to a +// DB2 FK violation (SQL0532/SQL0531) if the code is in use — +// RPG surfaces the SQLSTATE cleanly rather than pre-checking. +// Epic: PERP-2 (PERP-17) +// --------------------------------------------------------------------- + +ctl-opt dftactgrp(*no) actgrp(*new); + +dcl-f wrkcmd workstn sfile(cmsfl:rrn) sfile(cmmsgsfl:msgrrn); + +dcl-pr QMHSNDPM extpgm; + msgId char(7) const; + msgF char(20) const; + msgData char(256) const; + msgDataLen int(10) const; + msgType char(10) const; + stackEntry char(10) const; + stackCntr int(10) const; + msgKey char(4); + errorCode char(8) const; +end-pr; + +dcl-ds statusDS psds qualified; + programName char(10) pos(334); +end-ds; + +dcl-ds cmRow qualified; + ctype varchar(20); + cvalue varchar(20); + cdesc varchar(60); + cshort varchar(20); + csort int(10); + cactive char(1); +end-ds; + +dcl-ds rows likeds(cmRow) dim(500); +dcl-s numRows int(10); +dcl-s i int(10); +dcl-s rrn int(10); +dcl-s msgrrn int(10); +dcl-s msgkey char(4); +dcl-s selRrn int(10); +dcl-s selOpt char(1); +dcl-s filter varchar(20); +dcl-s holdMsg ind; +dcl-s validationFailed ind; + +filter = ''; +sftype = ''; + +dow not *in03 and not *in12; + // A message queued by an action handler below (addRow, etc.) must + // survive one full loop pass before being cleared, or it never + // reaches the screen -- clearMsgs wipes msgrrn back to 0 on the very + // next pass, before this pass's own exfmt ever shows it. holdMsg + // skips exactly one clearMsgs call right after such a message was + // queued. Same pattern as wrkitmr. + if holdMsg; + holdMsg = *off; + else; + exsr clearMsgs; + endif; + exsr loadRows; + + if numRows = 0; + *in30 = *off; + write cmnone; + else; + exsr fillSubfile; + *in30 = *on; + endif; + + write cmfoot; + if msgrrn > 0; + *in40 = *on; + write cmmsgctl; + else; + *in40 = *off; + endif; + exfmt cmctl; + + if *in03 or *in12; + leave; + endif; + + if *in05; + filter = sftype; + iter; + endif; + + if *in06; + exsr addRow; + iter; + endif; + + // Refresh filter from screen entry + if sftype <> filter; + filter = sftype; + iter; + endif; + + // Process subfile options. Guard on numRows: READC against a subfile + // that was never written to this cycle (0 rows loaded) raises a + // "Session or device error" (CPF5006-class) runtime error instead of + // just returning *EOF. + if numRows > 0; + selRrn = 0; + selOpt = ' '; + readc cmsfl; + dow not %eof(wrkcmd); + if sopt <> ''; + selRrn = rrn; + selOpt = sopt; + exsr handleOpt; + selRrn = 0; + endif; + readc cmsfl; + enddo; + endif; + +enddo; + +*inlr = *on; +return; + +// --------------------------------------------------------------------- +begsr loadRows; + numRows = 0; + if filter = ''; + exec sql declare c1 cursor for + select code_type, code_value, description, short_desc, + sort_order, is_active + from perpdemo.code_master + order by code_type, sort_order, code_value; + else; + exec sql declare c2 cursor for + select code_type, code_value, description, short_desc, + sort_order, is_active + from perpdemo.code_master + where code_type = :filter + order by sort_order, code_value; + endif; + + if filter = ''; + exec sql open c1; + else; + exec sql open c2; + endif; + if sqlcode < 0; + writeMsg('SQL open failed: SQLCODE=' + %char(sqlcode)); + holdMsg = *on; + leavesr; + endif; + + dow numRows < %elem(rows); + if filter = ''; + exec sql fetch c1 into :cmRow; + else; + exec sql fetch c2 into :cmRow; + endif; + if sqlcode = 100 or sqlcode < 0; + leave; + endif; + numRows += 1; + rows(numRows) = cmRow; + enddo; + + if filter = ''; + exec sql close c1; + else; + exec sql close c2; + endif; +endsr; + +// --------------------------------------------------------------------- +begsr fillSubfile; + rrn = 0; + *in31 = *on; + write cmctl; + *in31 = *off; + for i = 1 to numRows; + *in50 = *off; + *in51 = *off; + sopt = ''; + stype = rows(i).ctype; + svalue = rows(i).cvalue; + sdesc = rows(i).cdesc; + rrn += 1; + write cmsfl; + endfor; +endsr; + +// --------------------------------------------------------------------- +begsr handleOpt; + chain selRrn cmsfl; + if %found(wrkcmd); + select; + when selOpt = '2'; + exsr changeRow; + when selOpt = '4'; + exsr deleteRow; + when selOpt = '5'; + exsr displayRow; + other; + writeMsg('Option ' + selOpt + ' not valid.'); + holdMsg = *on; + endsl; + endif; +endsr; + +// --------------------------------------------------------------------- +begsr addRow; + exsr clearMsgs; + emode = 'A'; + etype = filter; + evalue = ''; + edesc = ''; + eshort = ''; + esort = 0; + eactive = 'Y'; + exsr editLoop; + if not *in12; + exsr validateCode; + if validationFailed; + holdMsg = *on; + else; + exec sql + insert into perpdemo.code_master + (code_type, code_value, description, short_desc, + sort_order, is_active) + values (:etype, :evalue, :edesc, :eshort, :esort, :eactive); + if sqlcode < 0; + writeMsg('Add failed: SQLCODE=' + %char(sqlcode) + + ' SQLSTATE=' + sqlstate); + else; + writeMsg('Added ' + %trim(etype) + '/' + %trim(evalue) + '.'); + endif; + holdMsg = *on; + endif; + endif; +endsr; + +// --------------------------------------------------------------------- +begsr changeRow; + exsr clearMsgs; + emode = 'C'; + etype = stype; + evalue = svalue; + exec sql + select description, short_desc, sort_order, is_active + into :edesc, :eshort, :esort, :eactive + from perpdemo.code_master + where code_type = :etype and code_value = :evalue; + if sqlcode <> 0; + writeMsg('Row disappeared before change.'); + holdMsg = *on; + leavesr; + endif; + exsr editLoop; + if not *in12; + exsr validateCode; + if validationFailed; + holdMsg = *on; + else; + exec sql + update perpdemo.code_master + set description = :edesc, + short_desc = :eshort, + sort_order = :esort, + is_active = :eactive, + updated_at = current_timestamp, + updated_by = user + where code_type = :etype and code_value = :evalue; + if sqlcode < 0; + writeMsg('Change failed: SQLCODE=' + %char(sqlcode)); + else; + writeMsg('Updated ' + %trim(etype) + '/' + %trim(evalue) + '.'); + endif; + holdMsg = *on; + endif; + endif; +endsr; + +// --------------------------------------------------------------------- +begsr deleteRow; + exsr clearMsgs; + exec sql + delete from perpdemo.code_master + where code_type = :stype and code_value = :svalue; + if sqlcode < 0; + writeMsg('Delete failed (in use?): SQLSTATE=' + sqlstate); + else; + writeMsg('Deleted ' + %trim(stype) + '/' + %trim(svalue) + '.'); + endif; + holdMsg = *on; +endsr; + +// --------------------------------------------------------------------- +begsr displayRow; + emode = 'D'; + etype = stype; + evalue = svalue; + exec sql + select description, short_desc, sort_order, is_active + into :edesc, :eshort, :esort, :eactive + from perpdemo.code_master + where code_type = :etype and code_value = :evalue; + exsr editLoop; +endsr; + +// --------------------------------------------------------------------- +begsr editLoop; + exfmt cmedit; +endsr; + +// --------------------------------------------------------------------- +// Required-field validation for the Add/Change panel, done here in RPG +// instead of letting a blank required field surface as a raw NOT-NULL +// violation from the database. +begsr validateCode; + validationFailed = *off; + if %trim(etype) = ''; + writeMsg('Code Type is required.'); + validationFailed = *on; + elseif %trim(evalue) = ''; + writeMsg('Code Value is required.'); + validationFailed = *on; + elseif %trim(edesc) = ''; + writeMsg('Description is required.'); + validationFailed = *on; + endif; +endsr; + +// --------------------------------------------------------------------- +begsr clearMsgs; + msgrrn = 0; + *in41 = *on; + write cmmsgctl; + *in41 = *off; +endsr; + +// --------------------------------------------------------------------- +dcl-proc writeMsg; + dcl-pi *n; + text varchar(256) const; + end-pi; + dcl-s data char(256); + data = text; + QMHSNDPM( + 'CPF9897' : + 'QCPFMSG QSYS ' : + data : + %len(text) : + '*INFO ' : + '* ' : + 1 : + smsgkey : + x'0000000000000000'); + msgrrn += 1; + spgmq = statusDS.programName; + write cmmsgsfl; +end-proc; diff --git a/perp/qrpglesrc/wrkcnvr.sqlrpgle b/perp/qrpglesrc/wrkcnvr.sqlrpgle new file mode 100644 index 00000000..686ed5e6 --- /dev/null +++ b/perp/qrpglesrc/wrkcnvr.sqlrpgle @@ -0,0 +1,397 @@ +**free + +// --------------------------------------------------------------------- +// Program: wrkcnvr (Work with Item UOM Conversions) +// Purpose: DSPF-based CRUD for item_uom_conversion, scoped to the +// company selected via perpselr (*LDA positions 1-3) and an +// item number entered on screen. Callable standalone from the +// PERP menu (PERP-21) or pre-scoped by passing company/item +// (PERP-23 item master maintenance calls it this way, option 6 +// on the item subfile). +// Example: for item WIDGET1, 1 CS = 12 EA. +// Epic: PERP-3 (PERP-21 / PERP-23) +// --------------------------------------------------------------------- + +ctl-opt dftactgrp(*no) actgrp(*new); + +dcl-pi *n; + pCompcd char(3) const options(*nopass); + pItem varchar(25) const options(*nopass); +end-pi; + +dcl-f wrkcnvd workstn sfile(cvsfl:rrn) sfile(cvmsgsfl:msgrrn); + +dcl-ds ldaDS dtaara(*lda) len(1024) qualified; + compcd char(3) pos(1); +end-ds; + +dcl-pr QMHSNDPM extpgm; + msgId char(7) const; + msgF char(20) const; + msgData char(256) const; + msgDataLen int(10) const; + msgType char(10) const; + stackEntry char(10) const; + stackCntr int(10) const; + msgKey char(4); + errorCode char(8) const; +end-pr; + +// Standard, reusable Item Number prompt (PERP-51/PERP-56). Same dynamic +// CALL idiom as wrkitmr's callWrkcnvr/callWrklotr. +dcl-pr callItmprmt extpgm('ITMPRMT'); + pCompcd char(3) const; + pItem varchar(25); +end-pr; + +dcl-ds statusDS psds qualified; + programName char(10) pos(334); +end-ds; + +dcl-ds cvRow qualified; + cfrom varchar(5); + cto varchar(5); + cfact packed(15:6); + cactive char(1); +end-ds; + +dcl-ds rows likeds(cvRow) dim(500); +dcl-s numRows int(10); +dcl-s i int(10); +dcl-s rrn int(10); +dcl-s msgrrn int(10); +dcl-s msgkey char(4); +dcl-s selRrn int(10); +dcl-s selOpt char(1); +dcl-s filter varchar(25); +dcl-s compcd char(3); +dcl-s promptItem varchar(25); +dcl-s holdMsg ind; +dcl-s validationFailed ind; + +in ldaDS; +compcd = ldaDS.compcd; +filter = ''; + +if %parms >= 1 and pCompcd <> ''; + compcd = pCompcd; +endif; +scompdsp = compcd; +sfitem = ''; +if %parms >= 2 and pItem <> ''; + filter = pItem; + sfitem = pItem; +endif; + +if compcd = ''; + exsr clearMsgs; + writeMsg('No company selected - run Select Company (PERPSELR) first.'); +endif; + +dow not *in03 and not *in12; + if compcd = ''; + *in30 = *off; + write cvnoitem; + write cvfoot; + if msgrrn > 0; + *in40 = *on; + write cvmsgctl; + else; + *in40 = *off; + endif; + exfmt cvctl; + leave; + endif; + + // A message queued by an action handler below (2=Change, etc.) must + // survive one full loop pass before being cleared, or it never + // reaches the screen -- clearMsgs wipes msgrrn back to 0 on the very + // next pass, before this pass's own exfmt ever shows it. holdMsg + // skips exactly one clearMsgs call right after such a message was + // queued. Same pattern as wrkivpr (PERP-74). + if holdMsg; + holdMsg = *off; + else; + exsr clearMsgs; + endif; + + if filter = ''; + *in30 = *off; + numRows = 0; + write cvnoitem; + else; + exsr loadRows; + if numRows = 0; + *in30 = *off; + write cvnone; + else; + exsr fillSubfile; + *in30 = *on; + endif; + endif; + + write cvfoot; + if msgrrn > 0; + *in40 = *on; + write cvmsgctl; + else; + *in40 = *off; + endif; + exfmt cvctl; + + if *in03 or *in12; + leave; + endif; + + if *in05; + filter = sfitem; + iter; + endif; + + if *in06; + if sfitem = ''; + writeMsg('Enter an item number before adding a conversion.'); + holdMsg = *on; + else; + filter = sfitem; + exsr addRow; + endif; + iter; + endif; + + // Item Number prompt (PERP-54): '?' + Enter invokes the standard + // reusable Item Number lookup (PERP-56) and returns the selection. + if %trim(sfitem) = '?'; + promptItem = sfitem; + callItmprmt(compcd : promptItem); + sfitem = promptItem; + filter = promptItem; + iter; + endif; + + // Refresh scope from screen entry + if sfitem <> filter; + filter = sfitem; + iter; + endif; + + // Process subfile options. Guard on numRows: READC against a subfile + // that was never written to this cycle (0 rows loaded) raises a + // "Session or device error" (CPF5006-class) runtime error instead of + // just returning *EOF. + if numRows > 0; + selRrn = 0; + selOpt = ' '; + readc cvsfl; + dow not %eof(wrkcnvd); + if sopt <> ''; + selRrn = rrn; + selOpt = sopt; + exsr handleOpt; + selRrn = 0; + endif; + readc cvsfl; + enddo; + endif; + +enddo; + +*inlr = *on; +return; + +// --------------------------------------------------------------------- +begsr loadRows; + numRows = 0; + exec sql declare c1 cursor for + select from_uom, to_uom, conversion_factor, is_active + from perpdemo.item_uom_conversion + where company_code = :compcd and item_number = :filter + order by from_uom, to_uom; + exec sql open c1; + if sqlcode < 0; + writeMsg('SQL open failed: SQLCODE=' + %char(sqlcode)); + leavesr; + endif; + + dow numRows < %elem(rows); + exec sql fetch c1 into :cvRow; + if sqlcode = 100 or sqlcode < 0; + leave; + endif; + numRows += 1; + rows(numRows) = cvRow; + enddo; + exec sql close c1; +endsr; + +// --------------------------------------------------------------------- +begsr fillSubfile; + rrn = 0; + *in31 = *on; + write cvctl; + *in31 = *off; + for i = 1 to numRows; + *in50 = *off; + *in51 = *off; + sopt = ''; + sfrom = rows(i).cfrom; + sto = rows(i).cto; + sfact = rows(i).cfact; + rrn += 1; + write cvsfl; + endfor; +endsr; + +// --------------------------------------------------------------------- +begsr handleOpt; + chain selRrn cvsfl; + if %found(wrkcnvd); + select; + when selOpt = '2'; + exsr changeRow; + when selOpt = '4'; + exsr deleteRow; + other; + writeMsg('Option ' + selOpt + ' not valid.'); + holdMsg = *on; + endsl; + endif; +endsr; + +// --------------------------------------------------------------------- +begsr addRow; + exsr clearMsgs; + emode = 'A'; + efrom = ''; + eto = ''; + efact = 0; + eactive = 'Y'; + exsr editLoop; + if not *in12; + exsr validateConv; + if validationFailed; + holdMsg = *on; + else; + exec sql + insert into perpdemo.item_uom_conversion + (company_code, item_number, from_uom, to_uom, conversion_factor, is_active) + values (:compcd, :filter, :efrom, :eto, :efact, :eactive); + if sqlcode < 0; + writeMsg('Add failed: SQLCODE=' + %char(sqlcode) + + ' SQLSTATE=' + sqlstate); + else; + writeMsg('Added ' + %trim(efrom) + ' -> ' + %trim(eto) + '.'); + endif; + holdMsg = *on; + endif; + endif; +endsr; + +// --------------------------------------------------------------------- +begsr changeRow; + exsr clearMsgs; + emode = 'C'; + efrom = sfrom; + eto = sto; + exec sql + select conversion_factor, is_active + into :efact, :eactive + from perpdemo.item_uom_conversion + where company_code = :compcd and item_number = :filter + and from_uom = :efrom and to_uom = :eto; + if sqlcode <> 0; + writeMsg('Row disappeared before change.'); + holdMsg = *on; + leavesr; + endif; + exsr editLoop; + if not *in12; + exsr validateConv; + if validationFailed; + holdMsg = *on; + else; + exec sql + update perpdemo.item_uom_conversion + set conversion_factor = :efact, + is_active = :eactive, + updated_at = current_timestamp, + updated_by = user + where company_code = :compcd and item_number = :filter + and from_uom = :efrom and to_uom = :eto; + if sqlcode < 0; + writeMsg('Change failed: SQLCODE=' + %char(sqlcode)); + else; + writeMsg('Updated ' + %trim(efrom) + ' -> ' + %trim(eto) + '.'); + endif; + holdMsg = *on; + endif; + endif; +endsr; + +// --------------------------------------------------------------------- +begsr deleteRow; + exsr clearMsgs; + exec sql + delete from perpdemo.item_uom_conversion + where company_code = :compcd and item_number = :filter + and from_uom = :sfrom and to_uom = :sto; + if sqlcode < 0; + writeMsg('Delete failed: SQLSTATE=' + sqlstate); + else; + writeMsg('Deleted ' + %trim(sfrom) + ' -> ' + %trim(sto) + '.'); + endif; + holdMsg = *on; +endsr; + +// --------------------------------------------------------------------- +begsr editLoop; + exfmt cvedit; +endsr; + +// --------------------------------------------------------------------- +// Required-field validation for the Add/Change panel, done here in RPG +// instead of letting a blank From/To UOM or zero Factor surface as a raw +// FK/CHECK-constraint violation from the database. +begsr validateConv; + validationFailed = *off; + if %trim(efrom) = ''; + writeMsg('From UOM is required.'); + validationFailed = *on; + elseif %trim(eto) = ''; + writeMsg('To UOM is required.'); + validationFailed = *on; + elseif efact <= 0; + writeMsg('Factor is required.'); + validationFailed = *on; + endif; +endsr; + +// --------------------------------------------------------------------- +begsr clearMsgs; + msgrrn = 0; + *in41 = *on; + write cvmsgctl; + *in41 = *off; +endsr; + +// --------------------------------------------------------------------- +dcl-proc writeMsg; + dcl-pi *n; + text varchar(256) const; + end-pi; + dcl-s data char(256); + data = text; + QMHSNDPM( + 'CPF9897' : + 'QCPFMSG QSYS ' : + data : + %len(text) : + '*INFO ' : + '* ' : + 1 : + smsgkey : + x'0000000000000000'); + msgrrn += 1; + spgmq = statusDS.programName; + write cvmsgsfl; +end-proc; diff --git a/perp/qrpglesrc/wrkiclr.sqlrpgle b/perp/qrpglesrc/wrkiclr.sqlrpgle new file mode 100644 index 00000000..2af17767 --- /dev/null +++ b/perp/qrpglesrc/wrkiclr.sqlrpgle @@ -0,0 +1,346 @@ +**free + +// --------------------------------------------------------------------- +// Program: wrkiclr (Work with Item Classes) +// Purpose: DSPF-based CRUD for item_class, scoped by the company +// selected via perpselr (*LDA positions 1-3). Options 2/4/5 +// change/delete/display; F6 adds. Delete falls through to a +// DB2 FK violation (SQL0532/SQL0531) if the class is +// referenced by item -- RPG surfaces the SQLSTATE cleanly +// rather than pre-checking. +// Epic: PERP-3 (PERP-22) +// --------------------------------------------------------------------- + +ctl-opt dftactgrp(*no) actgrp(*new); + +dcl-f wrkicld workstn sfile(icsfl:rrn) sfile(icmsgsfl:msgrrn); + +dcl-ds ldaDS dtaara(*lda) len(1024) qualified; + compcd char(3) pos(1); +end-ds; + +dcl-pr QMHSNDPM extpgm; + msgId char(7) const; + msgF char(20) const; + msgData char(256) const; + msgDataLen int(10) const; + msgType char(10) const; + stackEntry char(10) const; + stackCntr int(10) const; + msgKey char(4); + errorCode char(8) const; +end-pr; + +dcl-ds statusDS psds qualified; + programName char(10) pos(334); +end-ds; + +dcl-ds icRow qualified; + class varchar(10); + desc varchar(60); + active char(1); +end-ds; + +dcl-ds rows likeds(icRow) dim(500); +dcl-s numRows int(10); +dcl-s i int(10); +dcl-s rrn int(10); +dcl-s msgrrn int(10); +dcl-s msgkey char(4); +dcl-s selRrn int(10); +dcl-s selOpt char(1); +dcl-s compcd char(3); +dcl-s holdMsg ind; +dcl-s validationFailed ind; + +in ldaDS; +compcd = ldaDS.compcd; +scompdsp = compcd; + +if compcd = ''; + exsr clearMsgs; + writeMsg('No company selected - run Select Company (PERPSELR) first.'); +endif; + +dow not *in03 and not *in12; + if compcd = ''; + *in30 = *off; + write icnoco; + write icfoot; + if msgrrn > 0; + *in40 = *on; + write icmsgctl; + else; + *in40 = *off; + endif; + exfmt icctl; + leave; + endif; + + // A message queued by an action handler below (2=Change, etc.) must + // survive one full loop pass before being cleared, or it never + // reaches the screen -- clearMsgs wipes msgrrn back to 0 on the very + // next pass, before this pass's own exfmt ever shows it. holdMsg + // skips exactly one clearMsgs call right after such a message was + // queued. Same pattern as wrkivpr (PERP-74). + if holdMsg; + holdMsg = *off; + else; + exsr clearMsgs; + endif; + exsr loadRows; + + if numRows = 0; + *in30 = *off; + write icnone; + else; + exsr fillSubfile; + *in30 = *on; + endif; + + write icfoot; + if msgrrn > 0; + *in40 = *on; + write icmsgctl; + else; + *in40 = *off; + endif; + exfmt icctl; + + if *in03 or *in12; + leave; + endif; + + if *in05; + iter; + endif; + + if *in06; + exsr addRow; + iter; + endif; + + // Process subfile options. Guard on numRows: READC against a subfile + // that was never written to this cycle (0 rows loaded) raises a + // "Session or device error" (CPF5006-class) runtime error instead of + // just returning *EOF. + if numRows > 0; + selRrn = 0; + selOpt = ' '; + readc icsfl; + dow not %eof(wrkicld); + if sopt <> ''; + selRrn = rrn; + selOpt = sopt; + exsr handleOpt; + selRrn = 0; + endif; + readc icsfl; + enddo; + endif; + +enddo; + +*inlr = *on; +return; + +// --------------------------------------------------------------------- +begsr loadRows; + numRows = 0; + exec sql declare c1 cursor for + select class_code, description, is_active + from perpdemo.item_class + where company_code = :compcd + order by class_code; + exec sql open c1; + if sqlcode < 0; + writeMsg('SQL open failed: SQLCODE=' + %char(sqlcode)); + leavesr; + endif; + + dow numRows < %elem(rows); + exec sql fetch c1 into :icRow; + if sqlcode = 100 or sqlcode < 0; + leave; + endif; + numRows += 1; + rows(numRows) = icRow; + enddo; + exec sql close c1; +endsr; + +// --------------------------------------------------------------------- +begsr fillSubfile; + rrn = 0; + *in31 = *on; + write icctl; + *in31 = *off; + for i = 1 to numRows; + *in50 = *off; + *in51 = *off; + sopt = ''; + sclass = rows(i).class; + sdesc = rows(i).desc; + rrn += 1; + write icsfl; + endfor; +endsr; + +// --------------------------------------------------------------------- +begsr handleOpt; + chain selRrn icsfl; + if %found(wrkicld); + select; + when selOpt = '2'; + exsr changeRow; + when selOpt = '4'; + exsr deleteRow; + when selOpt = '5'; + exsr displayRow; + other; + writeMsg('Option ' + selOpt + ' not valid.'); + holdMsg = *on; + endsl; + endif; +endsr; + +// --------------------------------------------------------------------- +begsr addRow; + exsr clearMsgs; + emode = 'A'; + eclass = ''; + edesc = ''; + eactive = 'Y'; + exsr editLoop; + if not *in12; + exsr validateClass; + if validationFailed; + holdMsg = *on; + else; + exec sql + insert into perpdemo.item_class (company_code, class_code, description, is_active) + values (:compcd, :eclass, :edesc, :eactive); + if sqlcode < 0; + writeMsg('Add failed: SQLCODE=' + %char(sqlcode) + + ' SQLSTATE=' + sqlstate); + else; + writeMsg('Added ' + %trim(eclass) + '.'); + endif; + holdMsg = *on; + endif; + endif; +endsr; + +// --------------------------------------------------------------------- +begsr changeRow; + exsr clearMsgs; + emode = 'C'; + eclass = sclass; + exec sql + select description, is_active + into :edesc, :eactive + from perpdemo.item_class + where company_code = :compcd and class_code = :eclass; + if sqlcode <> 0; + writeMsg('Row disappeared before change.'); + holdMsg = *on; + leavesr; + endif; + exsr editLoop; + if not *in12; + exsr validateClass; + if validationFailed; + holdMsg = *on; + else; + exec sql + update perpdemo.item_class + set description = :edesc, + is_active = :eactive, + updated_at = current_timestamp, + updated_by = user + where company_code = :compcd and class_code = :eclass; + if sqlcode < 0; + writeMsg('Change failed: SQLCODE=' + %char(sqlcode)); + else; + writeMsg('Updated ' + %trim(eclass) + '.'); + endif; + holdMsg = *on; + endif; + endif; +endsr; + +// --------------------------------------------------------------------- +begsr deleteRow; + exsr clearMsgs; + exec sql + delete from perpdemo.item_class + where company_code = :compcd and class_code = :sclass; + if sqlcode < 0; + writeMsg('Delete failed (in use?): SQLSTATE=' + sqlstate); + else; + writeMsg('Deleted ' + %trim(sclass) + '.'); + endif; + holdMsg = *on; +endsr; + +// --------------------------------------------------------------------- +begsr displayRow; + emode = 'D'; + eclass = sclass; + exec sql + select description, is_active + into :edesc, :eactive + from perpdemo.item_class + where company_code = :compcd and class_code = :eclass; + exsr editLoop; +endsr; + +// --------------------------------------------------------------------- +begsr editLoop; + exfmt icedit; +endsr; + +// --------------------------------------------------------------------- +// Required-field validation for the Add/Change panel, done here in RPG +// instead of letting a blank required field surface as a raw NOT-NULL +// violation from the database. +begsr validateClass; + validationFailed = *off; + if %trim(eclass) = ''; + writeMsg('Class Code is required.'); + validationFailed = *on; + elseif %trim(edesc) = ''; + writeMsg('Description is required.'); + validationFailed = *on; + endif; +endsr; + +// --------------------------------------------------------------------- +begsr clearMsgs; + msgrrn = 0; + *in41 = *on; + write icmsgctl; + *in41 = *off; +endsr; + +// --------------------------------------------------------------------- +dcl-proc writeMsg; + dcl-pi *n; + text varchar(256) const; + end-pi; + dcl-s data char(256); + data = text; + QMHSNDPM( + 'CPF9897' : + 'QCPFMSG QSYS ' : + data : + %len(text) : + '*INFO ' : + '* ' : + 1 : + smsgkey : + x'0000000000000000'); + msgrrn += 1; + spgmq = statusDS.programName; + write icmsgsfl; +end-proc; diff --git a/perp/qrpglesrc/wrkitmr.sqlrpgle b/perp/qrpglesrc/wrkitmr.sqlrpgle new file mode 100644 index 00000000..1dd4ed80 --- /dev/null +++ b/perp/qrpglesrc/wrkitmr.sqlrpgle @@ -0,0 +1,531 @@ +**free + +// --------------------------------------------------------------------- +// Program: wrkitmr (Work with Items -- item master maintenance) +// Purpose: DSPF-based CRUD for item, scoped by the company selected via +// perpselr (*LDA positions 1-3). Subfile filters by class, +// active-only, and low-stock-only (qty_on_hand <= reorder_point). +// The edit panel covers descriptions/class/UOMs/lot flag, +// read-only balances, reorder parameters, and location. +// Balances are never written here -- per the epic, they're +// adjusted via receipt/reconciliation programs (later epics). +// Option 6 on the subfile calls wrkcnvr pre-scoped to the +// selected item, per PERP-21's "called from item maintenance" +// integration point. +// Epic: PERP-3 (PERP-23) +// --------------------------------------------------------------------- + +ctl-opt dftactgrp(*no) actgrp(*new); + +dcl-f wrkitmd workstn sfile(wisfl:rrn) sfile(wimsgsfl:msgrrn); + +dcl-ds ldaDS dtaara(*lda) len(1024) qualified; + compcd char(3) pos(1); +end-ds; + +dcl-pr QMHSNDPM extpgm; + msgId char(7) const; + msgF char(20) const; + msgData char(256) const; + msgDataLen int(10) const; + msgType char(10) const; + stackEntry char(10) const; + stackCntr int(10) const; + msgKey char(4); + errorCode char(8) const; +end-pr; + +dcl-pr callWrkcnvr extpgm('WRKCNVR'); + pCompcd char(3) const; + pItem varchar(25) const; +end-pr; + +dcl-pr callWrklotr extpgm('WRKLOTR'); + pCompcd char(3) const; + pItem varchar(25) const; +end-pr; + +// Standard, reusable Item Number prompt (PERP-51/PERP-56). Same dynamic +// CALL idiom as callWrkcnvr/callWrklotr above. +dcl-pr callItmprmt extpgm('ITMPRMT'); + pCompcd char(3) const; + pItem varchar(25); +end-pr; + +dcl-ds statusDS psds qualified; + programName char(10) pos(334); +end-ds; + +dcl-ds itemRow qualified; + item varchar(25); + desc varchar(60); + class varchar(10); + lotctl char(1); + onhand packed(15:4); + rordpt packed(15:4); +end-ds; + +dcl-ds rows likeds(itemRow) dim(500); +dcl-s numRows int(10); +dcl-s i int(10); +dcl-s rrn int(10); +dcl-s msgrrn int(10); +dcl-s msgkey char(4); +dcl-s selRrn int(10); +dcl-s selOpt char(1); +dcl-s compcd char(3); +dcl-s fClass varchar(10); +dcl-s fActOnly char(1); +dcl-s fLowOnly char(1); +dcl-s fPosTo varchar(30); +dcl-s promptItem varchar(25); +dcl-s holdMsg ind; +dcl-s validationFailed ind; + +in ldaDS; +compcd = ldaDS.compcd; +scompdsp = compcd; +fClass = ''; +fActOnly = 'N'; +fLowOnly = 'N'; +fPosTo = ''; +sfclass = ''; +sfact = 'N'; +sflow = 'N'; +sposto = ''; + +if compcd = ''; + exsr clearMsgs; + writeMsg('No company selected - run Select Company (PERPSELR) first.'); +endif; + +dow not *in03 and not *in12; + if compcd = ''; + *in30 = *off; + write winoco; + write wifoot; + if msgrrn > 0; + *in40 = *on; + write wimsgctl; + else; + *in40 = *off; + endif; + exfmt wictl; + leave; + endif; + + // A message queued by an action handler below (2=Change, etc.) must + // survive one full loop pass before being cleared, or it never + // reaches the screen -- clearMsgs wipes msgrrn back to 0 on the very + // next pass, before this pass's own exfmt ever shows it. holdMsg + // skips exactly one clearMsgs call right after such a message was + // queued. Same pattern as wrkivpr (PERP-74). + if holdMsg; + holdMsg = *off; + else; + exsr clearMsgs; + endif; + exsr loadRows; + + if numRows = 0; + *in30 = *off; + write winone; + else; + exsr fillSubfile; + *in30 = *on; + endif; + + write wifoot; + if msgrrn > 0; + *in40 = *on; + write wimsgctl; + else; + *in40 = *off; + endif; + exfmt wictl; + + if *in03 or *in12; + leave; + endif; + + if *in05; + fClass = sfclass; + fActOnly = sfact; + fLowOnly = sflow; + fPosTo = %trim(sposto); + iter; + endif; + + if *in06; + exsr addRow; + iter; + endif; + + // Refresh filters from screen entry + if sfclass <> fClass or sfact <> fActOnly or sflow <> fLowOnly + or sposto <> fPosTo; + fClass = sfclass; + fActOnly = sfact; + fLowOnly = sflow; + fPosTo = %trim(sposto); + iter; + endif; + + // Process subfile options. Guard on numRows: READC against a subfile + // that was never written to this cycle (0 rows loaded) raises a + // "Session or device error" (CPF5006-class) runtime error instead of + // just returning *EOF. + if numRows > 0; + selRrn = 0; + selOpt = ' '; + readc wisfl; + dow not %eof(wrkitmd); + if sopt <> ''; + selRrn = rrn; + selOpt = sopt; + exsr handleOpt; + selRrn = 0; + endif; + readc wisfl; + enddo; + endif; + +enddo; + +*inlr = *on; +return; + +// --------------------------------------------------------------------- +begsr loadRows; + numRows = 0; + exec sql declare c1 cursor for + select item_number, item_description, class_code, lot_controlled, + qty_on_hand, reorder_point + from perpdemo.item + where company_code = :compcd + and (:fClass = '' or class_code = :fClass) + and (:fActOnly = 'N' or is_active = 'Y') + and (:fLowOnly = 'N' or qty_on_hand <= reorder_point) + and (:fPosTo = '' + or upper(item_number) like upper(:fPosTo) || '%' + or upper(item_description) like '%' || upper(:fPosTo) || '%') + order by item_number; + exec sql open c1; + if sqlcode < 0; + writeMsg('SQL open failed: SQLCODE=' + %char(sqlcode)); + leavesr; + endif; + + dow numRows < %elem(rows); + exec sql fetch c1 into :itemRow; + if sqlcode = 100 or sqlcode < 0; + leave; + endif; + numRows += 1; + rows(numRows) = itemRow; + enddo; + exec sql close c1; +endsr; + +// --------------------------------------------------------------------- +begsr fillSubfile; + rrn = 0; + *in31 = *on; + write wictl; + *in31 = *off; + for i = 1 to numRows; + *in50 = *off; + *in51 = *off; + sopt = ''; + siitem = rows(i).item; + sidesc = rows(i).desc; + siclass = rows(i).class; + silot = rows(i).lotctl; + if rows(i).onhand <= rows(i).rordpt; + silow = '*'; + else; + silow = ''; + endif; + rrn += 1; + write wisfl; + endfor; +endsr; + +// --------------------------------------------------------------------- +begsr handleOpt; + chain selRrn wisfl; + if %found(wrkitmd); + select; + when selOpt = '2'; + exsr changeRow; + when selOpt = '4'; + exsr deleteRow; + when selOpt = '5'; + exsr displayRow; + when selOpt = '6'; + callWrkcnvr(compcd : siitem); + when selOpt = '7'; + callWrklotr(compcd : siitem); + other; + writeMsg('Option ' + selOpt + ' not valid.'); + endsl; + endif; +endsr; + +// --------------------------------------------------------------------- +begsr addRow; + // Clear any message left over from a PRIOR action before this one queues + // its own -- without this, pressing F6 again right after seeing a message + // (before the outer loop's own clearMsgs ever runs) stacks a second + // message behind the first, and the stale one shows instead of this + // action's real result. + exsr clearMsgs; + emode = 'A'; + // PERP-57: the item prompt makes no sense while adding a brand-new item + // (there's nothing to look up yet) -- *in60 on hides the "(? = prompt)" + // hint and skips the prompt-invocation check in editLoop below. + *in60 = *on; + eitem = ''; + edesc = ''; + eshort = ''; + eclass = fClass; + einvuom = ''; + estkuom = ''; + elotctl = 'N'; + eqoh = 0; + eqavl = 0; + eqfrz = 0; + eqoo = 0; + erordpt = 0; + ecritlv = 0; + eminqty = 0; + emaxqty = 0; + esafstk = 0; + eleadtm = 0; + eaisle = ''; + ebay = ''; + eshelf = ''; + // Loop so a failed insert redisplays THIS SAME panel with the error and + // the user's own entries intact, instead of bouncing back to the list -- + // only a successful add or an explicit Cancel (F12) leaves the loop. + dow *on; + exsr editLoop; + if *in12; + leave; + endif; + // Clear the message the user just saw (if any) before queuing THIS + // iteration's own result -- otherwise a retry within this same loop + // stacks its message behind the previous iteration's, same as the + // across-actions case clearMsgs at the top of this subroutine guards. + exsr clearMsgs; + exsr validateEdit; + if validationFailed; + holdMsg = *on; + iter; + endif; + exec sql + insert into perpdemo.item + (company_code, item_number, item_description, short_description, + class_code, inventory_uom, stocking_uom, lot_controlled, + reorder_point, critical_level, min_qty, max_qty, safety_stock, + lead_time_days, aisle_code, bay_code, shelf_code) + values (:compcd, :eitem, :edesc, :eshort, + :eclass, :einvuom, :estkuom, :elotctl, + :erordpt, :ecritlv, :eminqty, :emaxqty, :esafstk, + :eleadtm, :eaisle, :ebay, :eshelf); + if sqlcode < 0; + writeMsg('Add failed: SQLCODE=' + %char(sqlcode) + + ' SQLSTATE=' + sqlstate); + holdMsg = *on; + iter; + else; + writeMsg('Added ' + %trim(eitem) + '.'); + holdMsg = *on; + leave; + endif; + enddo; +endsr; + +// --------------------------------------------------------------------- +begsr changeRow; + exsr clearMsgs; + emode = 'C'; + *in60 = *off; + eitem = siitem; + exec sql + select item_description, short_description, class_code, + inventory_uom, stocking_uom, lot_controlled, + qty_on_hand, qty_available, qty_frozen, qty_on_order, + reorder_point, critical_level, min_qty, max_qty, safety_stock, + lead_time_days, aisle_code, bay_code, shelf_code + into :edesc, :eshort, :eclass, + :einvuom, :estkuom, :elotctl, + :eqoh, :eqavl, :eqfrz, :eqoo, + :erordpt, :ecritlv, :eminqty, :emaxqty, :esafstk, + :eleadtm, :eaisle, :ebay, :eshelf + from perpdemo.item + where company_code = :compcd and item_number = :eitem; + if sqlcode <> 0; + writeMsg('Row disappeared before change.'); + holdMsg = *on; + leavesr; + endif; + // Same retry-in-place shape as addRow: a failed update redisplays this + // panel with the error and the user's entries intact. + dow *on; + exsr editLoop; + if *in12; + leave; + endif; + exsr clearMsgs; + exsr validateEdit; + if validationFailed; + holdMsg = *on; + iter; + endif; + exec sql + update perpdemo.item + set item_description = :edesc, + short_description = :eshort, + class_code = :eclass, + inventory_uom = :einvuom, + stocking_uom = :estkuom, + lot_controlled = :elotctl, + reorder_point = :erordpt, + critical_level = :ecritlv, + min_qty = :eminqty, + max_qty = :emaxqty, + safety_stock = :esafstk, + lead_time_days = :eleadtm, + aisle_code = :eaisle, + bay_code = :ebay, + shelf_code = :eshelf, + updated_at = current_timestamp, + updated_by = user + where company_code = :compcd and item_number = :eitem; + if sqlcode < 0; + writeMsg('Change failed: SQLCODE=' + %char(sqlcode)); + holdMsg = *on; + iter; + else; + writeMsg('Updated ' + %trim(eitem) + '.'); + holdMsg = *on; + leave; + endif; + enddo; +endsr; + +// --------------------------------------------------------------------- +begsr deleteRow; + exsr clearMsgs; + exec sql + delete from perpdemo.item + where company_code = :compcd and item_number = :siitem; + if sqlcode < 0; + writeMsg('Delete failed (in use?): SQLSTATE=' + sqlstate); + else; + writeMsg('Deleted ' + %trim(siitem) + '.'); + endif; + holdMsg = *on; +endsr; + +// --------------------------------------------------------------------- +begsr displayRow; + emode = 'D'; + *in60 = *off; + eitem = siitem; + exec sql + select item_description, short_description, class_code, + inventory_uom, stocking_uom, lot_controlled, + qty_on_hand, qty_available, qty_frozen, qty_on_order, + reorder_point, critical_level, min_qty, max_qty, safety_stock, + lead_time_days, aisle_code, bay_code, shelf_code + into :edesc, :eshort, :eclass, + :einvuom, :estkuom, :elotctl, + :eqoh, :eqavl, :eqfrz, :eqoo, + :erordpt, :ecritlv, :eminqty, :emaxqty, :esafstk, + :eleadtm, :eaisle, :ebay, :eshelf + from perpdemo.item + where company_code = :compcd and item_number = :eitem; + exsr editLoop; +endsr; + +// --------------------------------------------------------------------- +begsr editLoop; + dow not *in12; + // Re-issue the message SFLCTL record before every exfmt on this format, + // exactly like the outer loop does for wictl -- otherwise a message + // queued by a failed insert/update (with the caller looping back into + // this same edit panel to show it) never reaches the screen, and any + // stale message left over from the calling list screen can bleed + // through WIEDIT's OVERLAY instead of being explicitly cleared. + *in40 = (msgrrn > 0); + write wimsgctl; + exfmt wiedit; + if *in12; + leave; + endif; + if not *in60 and %trim(eitem) = '?'; + promptItem = eitem; + callItmprmt(compcd : promptItem); + eitem = promptItem; + iter; + endif; + leave; + enddo; +endsr; + +// --------------------------------------------------------------------- +// Required-field validation for the Add/Change panel, done here in RPG +// instead of letting a blank required field surface as a raw FK violation +// (e.g. ITEM_STKUOM_FK) from the database. Checked in screen order so the +// first message matches the first blank field the user would fix. +begsr validateEdit; + validationFailed = *off; + if %trim(eitem) = ''; + writeMsg('Item Number is required.'); + validationFailed = *on; + elseif %trim(edesc) = ''; + writeMsg('Description is required.'); + validationFailed = *on; + elseif %trim(eclass) = ''; + writeMsg('Class is required.'); + validationFailed = *on; + elseif %trim(einvuom) = ''; + writeMsg('Inventory UOM is required.'); + validationFailed = *on; + elseif %trim(estkuom) = ''; + writeMsg('Stocking UOM is required.'); + validationFailed = *on; + endif; +endsr; + +// --------------------------------------------------------------------- +begsr clearMsgs; + msgrrn = 0; + *in41 = *on; + write wimsgctl; + *in41 = *off; +endsr; + +// --------------------------------------------------------------------- +dcl-proc writeMsg; + dcl-pi *n; + text varchar(256) const; + end-pi; + dcl-s data char(256); + data = text; + QMHSNDPM( + 'CPF9897' : + 'QCPFMSG QSYS ' : + data : + %len(text) : + '*INFO ' : + '* ' : + 1 : + smsgkey : + x'0000000000000000'); + msgrrn += 1; + spgmq = statusDS.programName; + write wimsgsfl; +end-proc; diff --git a/perp/qrpglesrc/wrkivnr.sqlrpgle b/perp/qrpglesrc/wrkivnr.sqlrpgle new file mode 100644 index 00000000..12740baa --- /dev/null +++ b/perp/qrpglesrc/wrkivnr.sqlrpgle @@ -0,0 +1,448 @@ +**free + +// --------------------------------------------------------------------- +// Program: wrkivnr (Work with Item-Vendor Profiles) +// Purpose: DSPF-based CRUD for item_vendor, scoped by the company +// selected via perpselr (*LDA positions 1-3) plus EITHER an +// item number OR a vendor code entered on screen (item wins +// if both are entered). Setting is_preferred = 'Y' lets DB2 +// reject the change via the item_vendor_preferred_ak partial +// unique index (SQLSTATE 23505) rather than pre-clearing the +// previous preferred row -- per the epic's "or lets DB reject +// the change with a clear error" option. +// Epic: PERP-5 (PERP-30) +// --------------------------------------------------------------------- + +ctl-opt dftactgrp(*no) actgrp(*new); + +dcl-f wrkivnd workstn sfile(ivsfl:rrn) sfile(ivmsgsfl:msgrrn); + +dcl-ds ldaDS dtaara(*lda) len(1024) qualified; + compcd char(3) pos(1); +end-ds; + +dcl-pr QMHSNDPM extpgm; + msgId char(7) const; + msgF char(20) const; + msgData char(256) const; + msgDataLen int(10) const; + msgType char(10) const; + stackEntry char(10) const; + stackCntr int(10) const; + msgKey char(4); + errorCode char(8) const; +end-pr; + +// Standard, reusable Item/Vendor Number prompts (PERP-51/PERP-56/PERP-70). +// Same dynamic CALL idiom as wrkitmr's callWrkcnvr/callWrklotr. +dcl-pr callItmprmt extpgm('ITMPRMT'); + pCompcd char(3) const; + pItem varchar(25); +end-pr; + +dcl-pr callVndprmt extpgm('VNDPRMT'); + pCompcd char(3) const; + pVendor varchar(10); +end-pr; + +dcl-ds statusDS psds qualified; + programName char(10) pos(334); +end-ds; + +dcl-ds ivRow qualified; + iitem varchar(25); + ivendor varchar(10); + ipartn varchar(25); + ilead int(10); + imoq packed(15:4); + ipack packed(15:4); + ipref char(1); +end-ds; + +dcl-ds rows likeds(ivRow) dim(500); +dcl-s numRows int(10); +dcl-s i int(10); +dcl-s rrn int(10); +dcl-s msgrrn int(10); +dcl-s msgkey char(4); +dcl-s selRrn int(10); +dcl-s selOpt char(1); +dcl-s compcd char(3); +dcl-s fItem varchar(25); +dcl-s fVendor varchar(10); +dcl-s promptItem varchar(25); +dcl-s promptVendor varchar(10); +dcl-s holdMsg ind; +dcl-s validationFailed ind; + +in ldaDS; +compcd = ldaDS.compcd; +scompdsp = compcd; +fItem = ''; +fVendor = ''; +sfitem = ''; +sfvendor = ''; + +if compcd = ''; + exsr clearMsgs; + writeMsg('No company selected - run Select Company (PERPSELR) first.'); +endif; + +dow not *in03 and not *in12; + if compcd = ''; + *in30 = *off; + write ivnoscp; + write ivfoot; + if msgrrn > 0; + *in40 = *on; + write ivmsgctl; + else; + *in40 = *off; + endif; + exfmt ivctl; + leave; + endif; + + // A message queued by an action handler below (F6=Add, 2=Change, + // etc.) must survive one full loop pass before being cleared, or it + // never reaches the screen -- clearMsgs wipes msgrrn back to 0 on + // the very next pass, before this pass's own exfmt ever shows it. + // holdMsg skips exactly one clearMsgs call right after such a + // message was queued. Same pattern as wrkivpr (PERP-74). + if holdMsg; + holdMsg = *off; + else; + exsr clearMsgs; + endif; + + if fItem = '' and fVendor = ''; + *in30 = *off; + numRows = 0; + write ivnoscp; + else; + exsr loadRows; + if numRows = 0; + *in30 = *off; + write ivnone; + else; + exsr fillSubfile; + *in30 = *on; + endif; + endif; + + write ivfoot; + if msgrrn > 0; + *in40 = *on; + write ivmsgctl; + else; + *in40 = *off; + endif; + exfmt ivctl; + + if *in03 or *in12; + leave; + endif; + + if *in05; + fItem = sfitem; + fVendor = sfvendor; + iter; + endif; + + if *in06; + exsr addRow; + iter; + endif; + + // Item/Vendor Number prompts (PERP-58/PERP-71): '?' + Enter invokes + // the standard reusable lookups (PERP-56/PERP-70) and returns the + // selection into the filter field that was prompted. + if %trim(sfitem) = '?'; + promptItem = sfitem; + callItmprmt(compcd : promptItem); + sfitem = promptItem; + fItem = promptItem; + iter; + endif; + + if %trim(sfvendor) = '?'; + promptVendor = sfvendor; + callVndprmt(compcd : promptVendor); + sfvendor = promptVendor; + fVendor = promptVendor; + iter; + endif; + + // Refresh scope from screen entry + if sfitem <> fItem or sfvendor <> fVendor; + fItem = sfitem; + fVendor = sfvendor; + iter; + endif; + + // Process subfile options. Guard on numRows: READC against a subfile + // that was never written to this cycle (0 rows loaded) raises a + // "Session or device error" (CPF5006-class) runtime error instead of + // just returning *EOF. + if numRows > 0; + selRrn = 0; + selOpt = ' '; + readc ivsfl; + dow not %eof(wrkivnd); + if sopt <> ''; + selRrn = rrn; + selOpt = sopt; + exsr handleOpt; + selRrn = 0; + endif; + readc ivsfl; + enddo; + endif; + +enddo; + +*inlr = *on; +return; + +// --------------------------------------------------------------------- +begsr loadRows; + numRows = 0; + exec sql declare iv1 cursor for + select item_number, vendor_code, vendor_part_number, lead_time_days, + moq, pack_size, is_preferred + from perpdemo.item_vendor + where company_code = :compcd + and (:fItem = '' or item_number = :fItem) + and (:fVendor = '' or vendor_code = :fVendor) + order by item_number, vendor_code; + exec sql open iv1; + if sqlcode < 0; + writeMsg('SQL open failed: SQLCODE=' + %char(sqlcode)); + leavesr; + endif; + + dow numRows < %elem(rows); + exec sql fetch iv1 into :ivRow; + if sqlcode = 100 or sqlcode < 0; + leave; + endif; + numRows += 1; + rows(numRows) = ivRow; + enddo; + exec sql close iv1; +endsr; + +// --------------------------------------------------------------------- +begsr fillSubfile; + rrn = 0; + *in31 = *on; + write ivctl; + *in31 = *off; + for i = 1 to numRows; + *in50 = *off; + *in51 = *off; + sopt = ''; + siitem = rows(i).iitem; + sivendor = rows(i).ivendor; + sipartn = rows(i).ipartn; + silead = rows(i).ilead; + simoq = rows(i).imoq; + sipack = rows(i).ipack; + sipref = rows(i).ipref; + rrn += 1; + write ivsfl; + endfor; +endsr; + +// --------------------------------------------------------------------- +begsr handleOpt; + chain selRrn ivsfl; + if %found(wrkivnd); + select; + when selOpt = '2'; + exsr changeRow; + when selOpt = '4'; + exsr deleteRow; + other; + writeMsg('Option ' + selOpt + ' not valid.'); + holdMsg = *on; + endsl; + endif; +endsr; + +// --------------------------------------------------------------------- +begsr addRow; + exsr clearMsgs; + if fItem = '' and fVendor = ''; + writeMsg('Enter an item or vendor before adding a profile.'); + holdMsg = *on; + leavesr; + endif; + emode = 'A'; + eitem = fItem; + evendor = fVendor; + epartn = ''; + eleadtm = 0; + emoq = 0; + epacksz = 1; + epref = 'N'; + eactive = 'Y'; + exsr editLoop; + if not *in12; + exsr validateVendorProfile; + if validationFailed; + holdMsg = *on; + else; + exec sql + insert into perpdemo.item_vendor + (company_code, item_number, vendor_code, vendor_part_number, + lead_time_days, moq, pack_size, is_preferred, is_active) + values (:compcd, :eitem, :evendor, :epartn, + :eleadtm, :emoq, :epacksz, :epref, :eactive); + if sqlcode = -803; + writeMsg('Add failed: another vendor is already preferred for' + + ' this item - clear it first.'); + elseif sqlcode < 0; + writeMsg('Add failed: SQLCODE=' + %char(sqlcode) + + ' SQLSTATE=' + sqlstate); + else; + writeMsg('Added ' + %trim(eitem) + '/' + %trim(evendor) + '.'); + endif; + holdMsg = *on; + endif; + endif; +endsr; + +// --------------------------------------------------------------------- +begsr changeRow; + exsr clearMsgs; + emode = 'C'; + eitem = siitem; + evendor = sivendor; + exec sql + select vendor_part_number, lead_time_days, moq, pack_size, + is_preferred, is_active + into :epartn, :eleadtm, :emoq, :epacksz, + :epref, :eactive + from perpdemo.item_vendor + where company_code = :compcd and item_number = :eitem + and vendor_code = :evendor; + if sqlcode <> 0; + writeMsg('Row disappeared before change.'); + holdMsg = *on; + leavesr; + endif; + exsr editLoop; + if not *in12; + exsr validateVendorProfile; + if validationFailed; + holdMsg = *on; + else; + exec sql + update perpdemo.item_vendor + set vendor_part_number = :epartn, + lead_time_days = :eleadtm, + moq = :emoq, + pack_size = :epacksz, + is_preferred = :epref, + is_active = :eactive, + updated_at = current_timestamp, + updated_by = user + where company_code = :compcd and item_number = :eitem + and vendor_code = :evendor; + if sqlcode = -803; + writeMsg('Change failed: another vendor is already preferred for' + + ' this item - clear it first.'); + elseif sqlcode < 0; + writeMsg('Change failed: SQLCODE=' + %char(sqlcode) + + ' SQLSTATE=' + sqlstate); + else; + writeMsg('Updated ' + %trim(eitem) + '/' + %trim(evendor) + '.'); + endif; + holdMsg = *on; + endif; + endif; +endsr; + +// --------------------------------------------------------------------- +begsr deleteRow; + exsr clearMsgs; + exec sql + delete from perpdemo.item_vendor + where company_code = :compcd and item_number = :siitem + and vendor_code = :sivendor; + if sqlcode < 0; + writeMsg('Delete failed (in use?): SQLSTATE=' + sqlstate); + else; + writeMsg('Deleted ' + %trim(siitem) + '/' + %trim(sivendor) + '.'); + endif; + holdMsg = *on; +endsr; + +// --------------------------------------------------------------------- +begsr editLoop; + dow not *in12; + exfmt ivedit; + if *in12; + leave; + endif; + if %trim(eitem) = '?'; + promptItem = eitem; + callItmprmt(compcd : promptItem); + eitem = promptItem; + iter; + endif; + if %trim(evendor) = '?'; + promptVendor = evendor; + callVndprmt(compcd : promptVendor); + evendor = promptVendor; + iter; + endif; + leave; + enddo; +endsr; + +// --------------------------------------------------------------------- +// Required-field validation for the Add/Change panel, done here in RPG +// instead of letting a blank required field surface as a raw FK/NOT-NULL +// violation from the database. +begsr validateVendorProfile; + validationFailed = *off; + if %trim(eitem) = ''; + writeMsg('Item Number is required.'); + validationFailed = *on; + elseif %trim(evendor) = ''; + writeMsg('Vendor Code is required.'); + validationFailed = *on; + endif; +endsr; + +// --------------------------------------------------------------------- +begsr clearMsgs; + msgrrn = 0; + *in41 = *on; + write ivmsgctl; + *in41 = *off; +endsr; + +// --------------------------------------------------------------------- +dcl-proc writeMsg; + dcl-pi *n; + text varchar(256) const; + end-pi; + dcl-s data char(256); + data = text; + QMHSNDPM( + 'CPF9897' : + 'QCPFMSG QSYS ' : + data : + %len(text) : + '*INFO ' : + '* ' : + 1 : + smsgkey : + x'0000000000000000'); + msgrrn += 1; + spgmq = statusDS.programName; + write ivmsgsfl; +end-proc; diff --git a/perp/qrpglesrc/wrkivpr.sqlrpgle b/perp/qrpglesrc/wrkivpr.sqlrpgle new file mode 100644 index 00000000..ff34989f --- /dev/null +++ b/perp/qrpglesrc/wrkivpr.sqlrpgle @@ -0,0 +1,331 @@ +**free + +// --------------------------------------------------------------------- +// Program: wrkivpr (Item-Vendor Price History / Add New Price) +// Purpose: Read-only history list for item_vendor_price scoped by an +// item + vendor entered on screen, plus F6=Add to enter a new +// current price. On add: the current row (effective_to IS +// NULL) is closed (effective_to = CURRENT_DATE) and a new row +// is inserted (effective_from = CURRENT_DATE, effective_to = +// NULL, unit_price = entered value). Historical rows are +// never updated or deleted here -- no subfile options exist. +// A second price entered the same day hits the table's own +// PRIMARY KEY (company_code, item_number, vendor_code, +// effective_from) and is rejected by DB2 (SQLCODE -803) -- +// "one price change per day" falls out of the PK for free. +// Epic: PERP-5 (PERP-31) +// --------------------------------------------------------------------- + +ctl-opt dftactgrp(*no) actgrp(*new); + +dcl-f wrkivpd workstn sfile(ipsfl:rrn) sfile(ipmsgsfl:msgrrn); + +dcl-ds ldaDS dtaara(*lda) len(1024) qualified; + compcd char(3) pos(1); +end-ds; + +dcl-pr QMHSNDPM extpgm; + msgId char(7) const; + msgF char(20) const; + msgData char(256) const; + msgDataLen int(10) const; + msgType char(10) const; + stackEntry char(10) const; + stackCntr int(10) const; + msgKey char(4); + errorCode char(8) const; +end-pr; + +// Standard, reusable Item/Vendor Number prompts (PERP-51/PERP-56/PERP-70). +// Same dynamic CALL idiom as wrkitmr's callWrkcnvr/callWrklotr. +dcl-pr callItmprmt extpgm('ITMPRMT'); + pCompcd char(3) const; + pItem varchar(25); +end-pr; + +dcl-pr callVndprmt extpgm('VNDPRMT'); + pCompcd char(3) const; + pVendor varchar(10); +end-pr; + +dcl-ds statusDS psds qualified; + programName char(10) pos(334); +end-ds; + +dcl-ds prcRow qualified; + efffrm char(10); + effto char(10); + price packed(15:4); + curr varchar(20); + src varchar(20); +end-ds; + +dcl-ds rows likeds(prcRow) dim(500); +dcl-s numRows int(10); +dcl-s i int(10); +dcl-s rrn int(10); +dcl-s msgrrn int(10); +dcl-s msgkey char(4); +dcl-s compcd char(3); +dcl-s fItem varchar(25); +dcl-s fVendor varchar(10); +dcl-s promptItem varchar(25); +dcl-s promptVendor varchar(10); +dcl-s holdMsg ind; + +in ldaDS; +compcd = ldaDS.compcd; +scompdsp = compcd; +fItem = ''; +fVendor = ''; +sfitem = ''; +sfvendor = ''; + +if compcd = ''; + exsr clearMsgs; + writeMsg('No company selected - run Select Company (PERPSELR) first.'); +endif; + +dow not *in03 and not *in12; + if compcd = ''; + *in30 = *off; + write ipnoscp; + write ipfoot; + if msgrrn > 0; + *in40 = *on; + write ipmsgctl; + else; + *in40 = *off; + endif; + exfmt ipctl; + leave; + endif; + + // PERP-74: a message queued by an action handler below (F6, etc.) + // must survive one full loop pass before being cleared, or it never + // reaches the screen -- clearMsgs wipes msgrrn back to 0 on the very + // next pass, before the "if msgrrn > 0" check further down ever sees + // it. holdMsg skips exactly one clearMsgs call right after such a + // message was queued. + if holdMsg; + holdMsg = *off; + else; + exsr clearMsgs; + endif; + + if fItem = '' or fVendor = ''; + *in30 = *off; + numRows = 0; + write ipnoscp; + else; + exsr loadRows; + if numRows = 0; + *in30 = *off; + write ipnone; + else; + exsr fillSubfile; + *in30 = *on; + endif; + endif; + + write ipfoot; + if msgrrn > 0; + *in40 = *on; + write ipmsgctl; + else; + *in40 = *off; + endif; + exfmt ipctl; + + if *in03 or *in12; + leave; + endif; + + if *in05; + fItem = sfitem; + fVendor = sfvendor; + iter; + endif; + + if *in06; + if fItem = '' or fVendor = ''; + writeMsg('Enter an item and vendor before adding a price.'); + else; + exsr addPrice; + endif; + if msgrrn > 0; + holdMsg = *on; + endif; + iter; + endif; + + // Item Number prompt (PERP-59): '?' + Enter invokes the standard + // reusable Item Number lookup (PERP-56) and returns the selection. + if %trim(sfitem) = '?'; + promptItem = sfitem; + callItmprmt(compcd : promptItem); + sfitem = promptItem; + fItem = promptItem; + iter; + endif; + + // Vendor Number prompt (PERP-75): '?' + Enter invokes the standard + // reusable Vendor Number lookup (PERP-70) and returns the selection. + if %trim(sfvendor) = '?'; + promptVendor = sfvendor; + callVndprmt(compcd : promptVendor); + sfvendor = promptVendor; + fVendor = promptVendor; + iter; + endif; + + // Refresh scope from screen entry + if sfitem <> fItem or sfvendor <> fVendor; + fItem = sfitem; + fVendor = sfvendor; + iter; + endif; +enddo; + +*inlr = *on; +return; + +// --------------------------------------------------------------------- +begsr loadRows; + numRows = 0; + // PERP-83: display as MM/DD/YY. effective_from/to are stored as + // native DATE columns but rendered here as plain strings (SEFFFRM/ + // SEFFTO carry no DATFMT keyword), so the format has to be built by + // hand from the ISO string -- DB2 for i's CHAR(date,fmt) built-in + // formats (ISO/USA/EUR/JIS) all use a 4-digit year, none produce a + // 2-digit year directly. + exec sql declare p1 cursor for + select substr(char(effective_from, iso), 6, 2) || '/' + || substr(char(effective_from, iso), 9, 2) || '/' + || substr(char(effective_from, iso), 3, 2), + case when effective_to is null then '' + else substr(char(effective_to, iso), 6, 2) || '/' + || substr(char(effective_to, iso), 9, 2) || '/' + || substr(char(effective_to, iso), 3, 2) + end, + unit_price, currency_code, price_source + from perpdemo.item_vendor_price + where company_code = :compcd and item_number = :fItem + and vendor_code = :fVendor + order by effective_from desc; + exec sql open p1; + if sqlcode < 0; + writeMsg('SQL open failed: SQLCODE=' + %char(sqlcode)); + leavesr; + endif; + + dow numRows < %elem(rows); + exec sql fetch p1 into :prcRow; + if sqlcode = 100 or sqlcode < 0; + leave; + endif; + numRows += 1; + rows(numRows) = prcRow; + enddo; + exec sql close p1; +endsr; + +// --------------------------------------------------------------------- +begsr fillSubfile; + rrn = 0; + *in31 = *on; + write ipctl; + *in31 = *off; + for i = 1 to numRows; + sefffrm = rows(i).efffrm; + seffto = rows(i).effto; + sprice = rows(i).price; + scurr = rows(i).curr; + ssrc = rows(i).src; + rrn += 1; + write ipsfl; + endfor; +endsr; + +// --------------------------------------------------------------------- +begsr addPrice; + eitem = fItem; + evendor = fVendor; + enewprc = 0; + ecurr = 'USD'; + eprcsrc = 'MANUAL'; + exfmt ipadd; + if *in12; + leavesr; + endif; + + if enewprc <= 0; + writeMsg('New Price is required.'); + leavesr; + endif; + if %trim(ecurr) = ''; + writeMsg('Currency is required.'); + leavesr; + endif; + + // Close the current row, if one exists (no current row is fine -- + // this is the very first price for this item-vendor). + exec sql + update perpdemo.item_vendor_price + set effective_to = current_date, + updated_at = current_timestamp, + updated_by = user + where company_code = :compcd and item_number = :fItem + and vendor_code = :fVendor and effective_to is null; + if sqlcode < 0; + writeMsg('Close of prior price failed: SQLCODE=' + %char(sqlcode)); + leavesr; + endif; + + exec sql + insert into perpdemo.item_vendor_price + (company_code, item_number, vendor_code, effective_from, + unit_price, currency_code, price_source) + values (:compcd, :fItem, :fVendor, current_date, + :enewprc, :ecurr, :eprcsrc); + if sqlcode = -803; + writeMsg('Add failed: a price was already entered today for this' + + ' item-vendor - only one price change per day.'); + elseif sqlcode < 0; + writeMsg('Add failed: SQLCODE=' + %char(sqlcode) + + ' SQLSTATE=' + sqlstate); + else; + writeMsg('New price ' + %char(enewprc) + ' ' + %trim(ecurr) + + ' effective today.'); + endif; +endsr; + +// --------------------------------------------------------------------- +begsr clearMsgs; + msgrrn = 0; + *in41 = *on; + write ipmsgctl; + *in41 = *off; +endsr; + +// --------------------------------------------------------------------- +dcl-proc writeMsg; + dcl-pi *n; + text varchar(256) const; + end-pi; + dcl-s data char(256); + data = text; + QMHSNDPM( + 'CPF9897' : + 'QCPFMSG QSYS ' : + data : + %len(text) : + '*INFO ' : + '* ' : + 1 : + smsgkey : + x'0000000000000000'); + msgrrn += 1; + spgmq = statusDS.programName; + write ipmsgsfl; +end-proc; diff --git a/perp/qrpglesrc/wrklotr.sqlrpgle b/perp/qrpglesrc/wrklotr.sqlrpgle new file mode 100644 index 00000000..0a96a17e --- /dev/null +++ b/perp/qrpglesrc/wrklotr.sqlrpgle @@ -0,0 +1,485 @@ +**free + +// --------------------------------------------------------------------- +// Program: wrklotr (Work with Item Lots) +// Purpose: DSPF-based CRUD for item_lot, scoped by the company selected +// via perpselr (*LDA positions 1-3) and an item number entered +// on screen (same scoping idiom as wrkcnvr). Shows item.on_hand +// alongside SUM(item_lot.qty_on_hand) and flags a discrepancy +// -- the entry point for the reconciliation demo (Option C: +// balances denormalized on both item and item_lot by design). +// Callable standalone or pre-scoped by passing company/item +// (mirrors wrkcnvr's PERP-23 integration). +// Epic: PERP-3 (PERP-24) +// --------------------------------------------------------------------- + +// PERP-84: datfmt(*iso) is required now that this program declares +// Date-typed variables (parsedRecv/parsedExpd below) to validate the +// MM/DD/YY Received/Expiry Date entry fields. Without this override the +// job's *MDY (1940-2039) DATFMT becomes the Date variables' storage +// format, per perp/AGENTS.md's RNQ0114 gotcha. +ctl-opt dftactgrp(*no) actgrp(*new) datfmt(*iso); + +dcl-pi *n; + pCompcd char(3) const options(*nopass); + pItem varchar(25) const options(*nopass); +end-pi; + +dcl-f wrklotd workstn sfile(ltsfl:rrn) sfile(ltmsgsfl:msgrrn); + +dcl-ds ldaDS dtaara(*lda) len(1024) qualified; + compcd char(3) pos(1); +end-ds; + +dcl-pr QMHSNDPM extpgm; + msgId char(7) const; + msgF char(20) const; + msgData char(256) const; + msgDataLen int(10) const; + msgType char(10) const; + stackEntry char(10) const; + stackCntr int(10) const; + msgKey char(4); + errorCode char(8) const; +end-pr; + +// Standard, reusable Item Number prompt (PERP-51/PERP-56). Same dynamic +// CALL idiom as wrkitmr's callWrkcnvr/callWrklotr. +dcl-pr callItmprmt extpgm('ITMPRMT'); + pCompcd char(3) const; + pItem varchar(25); +end-pr; + +dcl-ds statusDS psds qualified; + programName char(10) pos(334); +end-ds; + +dcl-ds ltRow qualified; + lot varchar(20); + qty packed(15:4); + recv varchar(10); + expd varchar(10); +end-ds; + +dcl-ds rows likeds(ltRow) dim(500); +dcl-s numRows int(10); +dcl-s i int(10); +dcl-s rrn int(10); +dcl-s msgrrn int(10); +dcl-s msgkey char(4); +dcl-s selRrn int(10); +dcl-s selOpt char(1); +dcl-s filter varchar(25); +dcl-s compcd char(3); +dcl-s itemOh packed(15:4); +dcl-s lotTotal packed(15:4); +dcl-s promptItem varchar(25); +dcl-s holdMsg ind; + +// PERP-84: MM/DD/YY entry validation for ERECV/EEXPD (see editLoop). +// parsedRecv/parsedExpd are Date-typed working vars used only to +// validate/reformat the typed text -- they are never bound directly to +// an SQL host variable (erecv/eexpd stay char(10) for that), so the +// SQL-precompiler-intermediate-host-variable *MDY cap documented in +// perp/AGENTS.md #13 does not come into play here. +dcl-s parsedRecv date; +dcl-s parsedExpd date; +dcl-s validRecv ind; +dcl-s validExpd ind; + +in ldaDS; +compcd = ldaDS.compcd; + +if %parms >= 1 and pCompcd <> ''; + compcd = pCompcd; +endif; +scompdsp = compcd; +filter = ''; +if %parms >= 2 and pItem <> ''; + filter = pItem; + sfitem = pItem; +else; + sfitem = ''; +endif; + +if compcd = ''; + exsr clearMsgs; + writeMsg('No company selected - run Select Company (PERPSELR) first.'); +endif; + +dow not *in03 and not *in12; + if compcd = ''; + *in30 = *off; + write ltnoitem; + write ltfoot; + if msgrrn > 0; + *in40 = *on; + write ltmsgctl; + else; + *in40 = *off; + endif; + exfmt ltctl; + leave; + endif; + + // A message queued by an action handler below (addRow, etc.) must + // survive one full loop pass before being cleared, or it never + // reaches the screen -- clearMsgs wipes msgrrn back to 0 on the very + // next pass, before this pass's own exfmt ever shows it. holdMsg + // skips exactly one clearMsgs call right after such a message was + // queued. Same pattern as wrkitmr. + if holdMsg; + holdMsg = *off; + else; + exsr clearMsgs; + endif; + + if filter = ''; + *in30 = *off; + *in60 = *off; + numRows = 0; + sioh = 0; + slottot = 0; + write ltnoitem; + else; + exsr loadBalances; + exsr loadRows; + if numRows = 0; + *in30 = *off; + write ltnone; + else; + exsr fillSubfile; + *in30 = *on; + endif; + endif; + + write ltfoot; + if msgrrn > 0; + *in40 = *on; + write ltmsgctl; + else; + *in40 = *off; + endif; + exfmt ltctl; + + if *in03 or *in12; + leave; + endif; + + if *in05; + filter = sfitem; + iter; + endif; + + if *in06; + if sfitem = ''; + writeMsg('Enter an item number before adding a lot.'); + holdMsg = *on; + else; + filter = sfitem; + exsr addRow; + endif; + iter; + endif; + + // Item Number prompt (PERP-60): '?' + Enter invokes the standard + // reusable Item Number lookup (PERP-56) and returns the selection. + if %trim(sfitem) = '?'; + promptItem = sfitem; + callItmprmt(compcd : promptItem); + sfitem = promptItem; + filter = promptItem; + iter; + endif; + + // Refresh scope from screen entry + if sfitem <> filter; + filter = sfitem; + iter; + endif; + + // Process subfile options. Guard on numRows: READC against a subfile + // that was never written to this cycle (0 rows loaded) raises a + // "Session or device error" (CPF5006-class) runtime error instead of + // just returning *EOF. + if numRows > 0; + selRrn = 0; + selOpt = ' '; + readc ltsfl; + dow not %eof(wrklotd); + if sopt <> ''; + selRrn = rrn; + selOpt = sopt; + exsr handleOpt; + selRrn = 0; + endif; + readc ltsfl; + enddo; + endif; + +enddo; + +*inlr = *on; +return; + +// --------------------------------------------------------------------- +begsr loadBalances; + exec sql + select qty_on_hand into :itemOh + from perpdemo.item + where company_code = :compcd and item_number = :filter; + if sqlcode <> 0; + itemOh = 0; + endif; + exec sql + select coalesce(sum(qty_on_hand), 0) into :lotTotal + from perpdemo.item_lot + where company_code = :compcd and item_number = :filter; + sioh = itemOh; + slottot = lotTotal; + if itemOh <> lotTotal; + *in60 = *on; + else; + *in60 = *off; + endif; +endsr; + +// --------------------------------------------------------------------- +begsr loadRows; + numRows = 0; + // PERP-84: display as MM/DD/YY. received_date/expiry_date are stored + // as native DATE columns but rendered here as plain strings (SRECV/ + // SEXPD carry no DATFMT keyword), so the format has to be built by + // hand from the ISO string -- DB2 for i's CHAR(date,fmt) built-in + // formats (ISO/USA/EUR/JIS) all use a 4-digit year, none produce a + // 2-digit year directly. Same technique as wrkivpr.sqlrpgle (PERP-83). + exec sql declare c1 cursor for + select lot_number, qty_on_hand, + substr(char(received_date, iso), 6, 2) || '/' + || substr(char(received_date, iso), 9, 2) || '/' + || substr(char(received_date, iso), 3, 2), + case when expiry_date is null then '' + else substr(char(expiry_date, iso), 6, 2) || '/' + || substr(char(expiry_date, iso), 9, 2) || '/' + || substr(char(expiry_date, iso), 3, 2) + end + from perpdemo.item_lot + where company_code = :compcd and item_number = :filter + order by lot_number; + exec sql open c1; + if sqlcode < 0; + writeMsg('SQL open failed: SQLCODE=' + %char(sqlcode)); + leavesr; + endif; + + dow numRows < %elem(rows); + exec sql fetch c1 into :ltRow; + if sqlcode = 100 or sqlcode < 0; + leave; + endif; + numRows += 1; + rows(numRows) = ltRow; + enddo; + exec sql close c1; +endsr; + +// --------------------------------------------------------------------- +begsr fillSubfile; + rrn = 0; + *in31 = *on; + write ltctl; + *in31 = *off; + for i = 1 to numRows; + *in50 = *off; + *in51 = *off; + sopt = ''; + slot = rows(i).lot; + sqty = rows(i).qty; + srecv = rows(i).recv; + sexpd = rows(i).expd; + rrn += 1; + write ltsfl; + endfor; +endsr; + +// --------------------------------------------------------------------- +begsr handleOpt; + chain selRrn ltsfl; + if %found(wrklotd); + select; + when selOpt = '2'; + exsr changeRow; + when selOpt = '4'; + exsr deleteRow; + other; + writeMsg('Option ' + selOpt + ' not valid.'); + holdMsg = *on; + endsl; + endif; +endsr; + +// --------------------------------------------------------------------- +begsr addRow; + exsr clearMsgs; + emode = 'A'; + elot = ''; + eqty = 0; + erecv = %char(%date():*mdy); + eexpd = ''; + eactive = 'Y'; + exsr editLoop; + if not *in12 and elot <> ''; + exec sql + insert into perpdemo.item_lot + (company_code, item_number, lot_number, qty_on_hand, received_date, expiry_date) + values (:compcd, :filter, :elot, :eqty, date(:erecv), + case when :eexpd = '' then null else date(:eexpd) end); + if sqlcode < 0; + writeMsg('Add failed: SQLCODE=' + %char(sqlcode) + + ' SQLSTATE=' + sqlstate); + else; + writeMsg('Added lot ' + %trim(elot) + '.'); + endif; + holdMsg = *on; + endif; +endsr; + +// --------------------------------------------------------------------- +begsr changeRow; + exsr clearMsgs; + emode = 'C'; + elot = slot; + eqty = sqty; + erecv = srecv; + eexpd = sexpd; + eactive = 'Y'; + exsr editLoop; + if not *in12; + exec sql + update perpdemo.item_lot + set qty_on_hand = :eqty, + received_date = date(:erecv), + expiry_date = case when :eexpd = '' then null else date(:eexpd) end, + updated_at = current_timestamp, + updated_by = user + where company_code = :compcd and item_number = :filter and lot_number = :elot; + if sqlcode < 0; + writeMsg('Change failed: SQLCODE=' + %char(sqlcode)); + else; + writeMsg('Updated lot ' + %trim(elot) + '.'); + endif; + holdMsg = *on; + endif; +endsr; + +// --------------------------------------------------------------------- +begsr deleteRow; + exsr clearMsgs; + exec sql + delete from perpdemo.item_lot + where company_code = :compcd and item_number = :filter and lot_number = :slot; + if sqlcode < 0; + writeMsg('Delete failed: SQLSTATE=' + sqlstate); + else; + writeMsg('Deleted lot ' + %trim(slot) + '.'); + endif; + holdMsg = *on; +endsr; + +// --------------------------------------------------------------------- +// PERP-84: erecv/eexpd are typed by the user as MM/DD/YY on LTEDIT. +// Validate on every Enter; on failure, show the error in the message +// subfile alongside LTEDIT and let the user retry (never crash into +// the SQL date(:erecv) cast in addRow/changeRow with unparsed text). +// On success, erecv/eexpd are normalized to ISO ('yyyy-mm-dd') text so +// the existing date(:erecv)/date(:eexpd) SQL casts in addRow/changeRow +// keep working unchanged. +begsr editLoop; + exsr clearMsgs; + dow *on; + if msgrrn > 0; + *in40 = *on; + write ltmsgctl; + else; + *in40 = *off; + endif; + exfmt ltedit; + + if *in12; + leave; + endif; + + exsr clearMsgs; + + if %trim(elot) = ''; + writeMsg('Lot Number is required.'); + iter; + endif; + + if %trim(erecv) = ''; + writeMsg('Received Date is required (MM/DD/YY).'); + iter; + endif; + + validRecv = *on; + monitor; + parsedRecv = %date(%trim(erecv):*mdy); + on-error; + validRecv = *off; + endmon; + if not validRecv; + writeMsg('Invalid Received Date - enter as MM/DD/YY.'); + iter; + endif; + + validExpd = *on; + if %trim(eexpd) <> ''; + monitor; + parsedExpd = %date(%trim(eexpd):*mdy); + on-error; + validExpd = *off; + endmon; + endif; + if not validExpd; + writeMsg('Invalid Expiry Date - enter as MM/DD/YY, or blank for none.'); + iter; + endif; + + erecv = %char(parsedRecv:*iso); + if %trim(eexpd) <> ''; + eexpd = %char(parsedExpd:*iso); + endif; + + leave; + enddo; +endsr; + +// --------------------------------------------------------------------- +begsr clearMsgs; + msgrrn = 0; + *in41 = *on; + write ltmsgctl; + *in41 = *off; +endsr; + +// --------------------------------------------------------------------- +dcl-proc writeMsg; + dcl-pi *n; + text varchar(256) const; + end-pi; + dcl-s data char(256); + data = text; + QMHSNDPM( + 'CPF9897' : + 'QCPFMSG QSYS ' : + data : + %len(text) : + '*INFO ' : + '* ' : + 1 : + smsgkey : + x'0000000000000000'); + msgrrn += 1; + spgmq = statusDS.programName; + write ltmsgsfl; +end-proc; diff --git a/perp/qrpglesrc/wrkuomr.sqlrpgle b/perp/qrpglesrc/wrkuomr.sqlrpgle new file mode 100644 index 00000000..69051a0e --- /dev/null +++ b/perp/qrpglesrc/wrkuomr.sqlrpgle @@ -0,0 +1,322 @@ +**free + +// --------------------------------------------------------------------- +// Program: wrkuomr (Work with Units of Measure) +// Purpose: DSPF-based CRUD for the uom table. Global (not company- +// scoped) master data. Options 2/4/5 change/delete/display; +// F6 adds. Delete falls through to a DB2 FK violation +// (SQL0532/SQL0531) if the UOM is referenced by item or +// item_uom_conversion -- RPG surfaces the SQLSTATE cleanly +// rather than pre-checking. +// Epic: PERP-3 (PERP-21) +// --------------------------------------------------------------------- + +ctl-opt dftactgrp(*no) actgrp(*new); + +dcl-f wrkuomd workstn sfile(uosfl:rrn) sfile(uomsgsfl:msgrrn); + +dcl-pr QMHSNDPM extpgm; + msgId char(7) const; + msgF char(20) const; + msgData char(256) const; + msgDataLen int(10) const; + msgType char(10) const; + stackEntry char(10) const; + stackCntr int(10) const; + msgKey char(4); + errorCode char(8) const; +end-pr; + +dcl-ds statusDS psds qualified; + programName char(10) pos(334); +end-ds; + +dcl-ds uomRow qualified; + code varchar(5); + desc varchar(60); + cat varchar(20); + active char(1); +end-ds; + +dcl-ds rows likeds(uomRow) dim(500); +dcl-s numRows int(10); +dcl-s i int(10); +dcl-s rrn int(10); +dcl-s msgrrn int(10); +dcl-s msgkey char(4); +dcl-s selRrn int(10); +dcl-s selOpt char(1); +dcl-s holdMsg ind; +dcl-s validationFailed ind; + +dow not *in03 and not *in12; + // A message queued by an action handler below (addRow, etc.) must + // survive one full loop pass before being cleared, or it never + // reaches the screen -- clearMsgs wipes msgrrn back to 0 on the very + // next pass, before this pass's own exfmt ever shows it. holdMsg + // skips exactly one clearMsgs call right after such a message was + // queued. Same pattern as wrkitmr. + if holdMsg; + holdMsg = *off; + else; + exsr clearMsgs; + endif; + exsr loadRows; + + if numRows = 0; + *in30 = *off; + write uonone; + else; + exsr fillSubfile; + *in30 = *on; + endif; + + write uofoot; + if msgrrn > 0; + *in40 = *on; + write uomsgctl; + else; + *in40 = *off; + endif; + exfmt uoctl; + + if *in03 or *in12; + leave; + endif; + + if *in05; + iter; + endif; + + if *in06; + exsr addRow; + iter; + endif; + + // Process subfile options. Guard on numRows: READC against a subfile + // that was never written to this cycle (0 rows loaded) raises a + // "Session or device error" (CPF5006-class) runtime error instead of + // just returning *EOF. + if numRows > 0; + selRrn = 0; + selOpt = ' '; + readc uosfl; + dow not %eof(wrkuomd); + if sopt <> ''; + selRrn = rrn; + selOpt = sopt; + exsr handleOpt; + selRrn = 0; + endif; + readc uosfl; + enddo; + endif; + +enddo; + +*inlr = *on; +return; + +// --------------------------------------------------------------------- +begsr loadRows; + numRows = 0; + exec sql declare c1 cursor for + select uom_code, description, uom_category, is_active + from perpdemo.uom + order by uom_code; + exec sql open c1; + if sqlcode < 0; + writeMsg('SQL open failed: SQLCODE=' + %char(sqlcode)); + holdMsg = *on; + leavesr; + endif; + + dow numRows < %elem(rows); + exec sql fetch c1 into :uomRow; + if sqlcode = 100 or sqlcode < 0; + leave; + endif; + numRows += 1; + rows(numRows) = uomRow; + enddo; + exec sql close c1; +endsr; + +// --------------------------------------------------------------------- +begsr fillSubfile; + rrn = 0; + *in31 = *on; + write uoctl; + *in31 = *off; + for i = 1 to numRows; + *in50 = *off; + *in51 = *off; + sopt = ''; + scode = rows(i).code; + sdesc = rows(i).desc; + scat = rows(i).cat; + rrn += 1; + write uosfl; + endfor; +endsr; + +// --------------------------------------------------------------------- +begsr handleOpt; + chain selRrn uosfl; + if %found(wrkuomd); + select; + when selOpt = '2'; + exsr changeRow; + when selOpt = '4'; + exsr deleteRow; + when selOpt = '5'; + exsr displayRow; + other; + writeMsg('Option ' + selOpt + ' not valid.'); + holdMsg = *on; + endsl; + endif; +endsr; + +// --------------------------------------------------------------------- +begsr addRow; + exsr clearMsgs; + emode = 'A'; + ecode = ''; + edesc = ''; + ecat = ''; + eactive = 'Y'; + exsr editLoop; + if not *in12; + exsr validateUom; + if validationFailed; + holdMsg = *on; + else; + exec sql + insert into perpdemo.uom (uom_code, description, uom_category, is_active) + values (:ecode, :edesc, :ecat, :eactive); + if sqlcode < 0; + writeMsg('Add failed: SQLCODE=' + %char(sqlcode) + + ' SQLSTATE=' + sqlstate); + else; + writeMsg('Added ' + %trim(ecode) + '.'); + endif; + holdMsg = *on; + endif; + endif; +endsr; + +// --------------------------------------------------------------------- +begsr changeRow; + exsr clearMsgs; + emode = 'C'; + ecode = scode; + exec sql + select description, uom_category, is_active + into :edesc, :ecat, :eactive + from perpdemo.uom + where uom_code = :ecode; + if sqlcode <> 0; + writeMsg('Row disappeared before change.'); + holdMsg = *on; + leavesr; + endif; + exsr editLoop; + if not *in12; + exsr validateUom; + if validationFailed; + holdMsg = *on; + else; + exec sql + update perpdemo.uom + set description = :edesc, + uom_category = :ecat, + is_active = :eactive, + updated_at = current_timestamp, + updated_by = user + where uom_code = :ecode; + if sqlcode < 0; + writeMsg('Change failed: SQLCODE=' + %char(sqlcode)); + else; + writeMsg('Updated ' + %trim(ecode) + '.'); + endif; + holdMsg = *on; + endif; + endif; +endsr; + +// --------------------------------------------------------------------- +begsr deleteRow; + exsr clearMsgs; + exec sql + delete from perpdemo.uom + where uom_code = :scode; + if sqlcode < 0; + writeMsg('Delete failed (in use?): SQLSTATE=' + sqlstate); + else; + writeMsg('Deleted ' + %trim(scode) + '.'); + endif; + holdMsg = *on; +endsr; + +// --------------------------------------------------------------------- +begsr displayRow; + emode = 'D'; + ecode = scode; + exec sql + select description, uom_category, is_active + into :edesc, :ecat, :eactive + from perpdemo.uom + where uom_code = :ecode; + exsr editLoop; +endsr; + +// --------------------------------------------------------------------- +begsr editLoop; + exfmt uoedit; +endsr; + +// --------------------------------------------------------------------- +// Required-field validation for the Add/Change panel, done here in RPG +// instead of letting a blank required field surface as a raw NOT-NULL +// violation from the database. +begsr validateUom; + validationFailed = *off; + if %trim(ecode) = ''; + writeMsg('UOM Code is required.'); + validationFailed = *on; + elseif %trim(edesc) = ''; + writeMsg('Description is required.'); + validationFailed = *on; + endif; +endsr; + +// --------------------------------------------------------------------- +begsr clearMsgs; + msgrrn = 0; + *in41 = *on; + write uomsgctl; + *in41 = *off; +endsr; + +// --------------------------------------------------------------------- +dcl-proc writeMsg; + dcl-pi *n; + text varchar(256) const; + end-pi; + dcl-s data char(256); + data = text; + QMHSNDPM( + 'CPF9897' : + 'QCPFMSG QSYS ' : + data : + %len(text) : + '*INFO ' : + '* ' : + 1 : + smsgkey : + x'0000000000000000'); + msgrrn += 1; + spgmq = statusDS.programName; + write uomsgsfl; +end-proc; diff --git a/perp/qrpglesrc/wrkusrr.sqlrpgle b/perp/qrpglesrc/wrkusrr.sqlrpgle new file mode 100644 index 00000000..03235e58 --- /dev/null +++ b/perp/qrpglesrc/wrkusrr.sqlrpgle @@ -0,0 +1,324 @@ +**free + +// --------------------------------------------------------------------- +// Program: wrkusrr (Work with PERP Users) +// Purpose: DSPF-based CRUD for the perp_user table. Same pattern as +// wrkcmr — subfile list + edit format. Role FK is enforced +// by DB2; if the caller types a role_code that is not in +// code_master (USERROLE), INSERT/UPDATE returns SQLSTATE +// 23503 which the RPG surfaces to the message subfile. +// Epic: PERP-2 (PERP-18) +// --------------------------------------------------------------------- + +ctl-opt dftactgrp(*no) actgrp(*new); + +dcl-f wrkusrd workstn sfile(usfl:rrn) sfile(umsgsfl:msgrrn); + +dcl-pr QMHSNDPM extpgm; + msgId char(7) const; + msgF char(20) const; + msgData char(256) const; + msgDataLen int(10) const; + msgType char(10) const; + stackEntry char(10) const; + stackCntr int(10) const; + msgKey char(4); + errorCode char(8) const; +end-pr; + +dcl-ds statusDS psds qualified; + programName char(10) pos(334); +end-ds; + +dcl-ds uRow qualified; + ucode char(10); + uname varchar(60); + uemail varchar(120); + urole varchar(20); + uact char(1); +end-ds; + +dcl-ds rows likeds(uRow) dim(500); +dcl-s numRows int(10); +dcl-s i int(10); +dcl-s rrn int(10); +dcl-s msgrrn int(10); +dcl-s msgkey char(4); +dcl-s selRrn int(10); +dcl-s selOpt char(1); +dcl-s holdMsg ind; +dcl-s validationFailed ind; + +dow not *in03 and not *in12; + // A message queued by an action handler below (2=Change, etc.) must + // survive one full loop pass before being cleared, or it never + // reaches the screen -- clearMsgs wipes msgrrn back to 0 on the very + // next pass, before this pass's own exfmt ever shows it. holdMsg + // skips exactly one clearMsgs call right after such a message was + // queued. Same pattern as wrkivpr (PERP-74). + if holdMsg; + holdMsg = *off; + else; + exsr clearMsgs; + endif; + exsr loadRows; + + if numRows = 0; + *in30 = *off; + write unone; + else; + exsr fillSubfile; + *in30 = *on; + endif; + + write ufoot; + if msgrrn > 0; + *in40 = *on; + write umsgctl; + else; + *in40 = *off; + endif; + exfmt uctl; + + if *in03 or *in12; + leave; + endif; + + if *in05; + iter; + endif; + + if *in06; + exsr addRow; + iter; + endif; + + // Guard on numRows: READC against a subfile that was never written to + // this cycle (0 rows loaded) raises a "Session or device error" + // (CPF5006-class) runtime error instead of just returning *EOF. + if numRows > 0; + selRrn = 0; + selOpt = ' '; + readc usfl; + dow not %eof(wrkusrd); + if sopt <> ''; + selRrn = rrn; + selOpt = sopt; + exsr handleOpt; + selRrn = 0; + endif; + readc usfl; + enddo; + endif; +enddo; + +*inlr = *on; +return; + +// --------------------------------------------------------------------- +begsr loadRows; + numRows = 0; + exec sql declare u1 cursor for + select user_code, display_name, email_address, role_code, is_active + from perpdemo.perp_user + order by user_code; + exec sql open u1; + if sqlcode < 0; + writeMsg('SQL open failed: SQLCODE=' + %char(sqlcode)); + leavesr; + endif; + + dow numRows < %elem(rows); + exec sql fetch u1 into :uRow; + if sqlcode = 100 or sqlcode < 0; + leave; + endif; + numRows += 1; + rows(numRows) = uRow; + enddo; + exec sql close u1; +endsr; + +// --------------------------------------------------------------------- +begsr fillSubfile; + rrn = 0; + *in31 = *on; + write uctl; + *in31 = *off; + for i = 1 to numRows; + *in50 = *off; + *in51 = *off; + sopt = ''; + sucode = rows(i).ucode; + suname = rows(i).uname; + surole = rows(i).urole; + suact = rows(i).uact; + rrn += 1; + write usfl; + endfor; +endsr; + +// --------------------------------------------------------------------- +begsr handleOpt; + chain selRrn usfl; + if %found(wrkusrd); + select; + when selOpt = '2'; + exsr changeRow; + when selOpt = '4'; + exsr deleteRow; + when selOpt = '5'; + exsr displayRow; + other; + writeMsg('Option ' + selOpt + ' not valid.'); + holdMsg = *on; + endsl; + endif; +endsr; + +// --------------------------------------------------------------------- +begsr addRow; + exsr clearMsgs; + emode = 'A'; + eucode = ''; + euname = ''; + euemail = ''; + eurole = 'REQUESTER'; + euact = 'Y'; + exsr editLoop; + if not *in12; + exsr validateUser; + if validationFailed; + holdMsg = *on; + else; + exec sql + insert into perpdemo.perp_user + (user_code, display_name, email_address, role_code, is_active) + values (:eucode, :euname, :euemail, :eurole, :euact); + if sqlcode < 0; + writeMsg('Add failed: SQLCODE=' + %char(sqlcode) + + ' SQLSTATE=' + sqlstate); + else; + writeMsg('Added ' + %trim(eucode) + '.'); + endif; + holdMsg = *on; + endif; + endif; +endsr; + +// --------------------------------------------------------------------- +begsr changeRow; + exsr clearMsgs; + emode = 'C'; + eucode = sucode; + exec sql + select display_name, email_address, role_code, is_active + into :euname, :euemail, :eurole, :euact + from perpdemo.perp_user + where user_code = :eucode; + if sqlcode <> 0; + writeMsg('Row disappeared before change.'); + holdMsg = *on; + leavesr; + endif; + exsr editLoop; + if not *in12; + exsr validateUser; + if validationFailed; + holdMsg = *on; + else; + exec sql + update perpdemo.perp_user + set display_name = :euname, + email_address = :euemail, + role_code = :eurole, + is_active = :euact, + updated_at = current_timestamp, + updated_by = user + where user_code = :eucode; + if sqlcode < 0; + writeMsg('Change failed: SQLCODE=' + %char(sqlcode) + + ' SQLSTATE=' + sqlstate); + else; + writeMsg('Updated ' + %trim(eucode) + '.'); + endif; + holdMsg = *on; + endif; + endif; +endsr; + +// --------------------------------------------------------------------- +begsr deleteRow; + exsr clearMsgs; + exec sql + delete from perpdemo.perp_user + where user_code = :sucode; + if sqlcode < 0; + writeMsg('Delete failed: SQLSTATE=' + sqlstate); + else; + writeMsg('Deleted ' + %trim(sucode) + '.'); + endif; + holdMsg = *on; +endsr; + +// --------------------------------------------------------------------- +begsr displayRow; + emode = 'D'; + eucode = sucode; + exec sql + select display_name, email_address, role_code, is_active + into :euname, :euemail, :eurole, :euact + from perpdemo.perp_user + where user_code = :eucode; + exsr editLoop; +endsr; + +// --------------------------------------------------------------------- +begsr editLoop; + exfmt uedit; +endsr; + +// --------------------------------------------------------------------- +// Required-field validation for the Add/Change panel, done here in RPG +// instead of letting a blank required field surface as a raw FK/NOT-NULL +// violation from the database. +begsr validateUser; + validationFailed = *off; + if %trim(eucode) = ''; + writeMsg('User Code is required.'); + validationFailed = *on; + elseif %trim(eurole) = ''; + writeMsg('Role is required.'); + validationFailed = *on; + endif; +endsr; + +// --------------------------------------------------------------------- +begsr clearMsgs; + msgrrn = 0; + *in41 = *on; + write umsgctl; + *in41 = *off; +endsr; + +// --------------------------------------------------------------------- +dcl-proc writeMsg; + dcl-pi *n; + text varchar(256) const; + end-pi; + dcl-s data char(256); + data = text; + QMHSNDPM( + 'CPF9897' : + 'QCPFMSG QSYS ' : + data : + %len(text) : + '*INFO ' : + '* ' : + 1 : + smsgkey : + x'0000000000000000'); + msgrrn += 1; + spgmq = statusDS.programName; + write umsgsfl; +end-proc; diff --git a/perp/qrpglesrc/wrkvndr.sqlrpgle b/perp/qrpglesrc/wrkvndr.sqlrpgle new file mode 100644 index 00000000..be05118c --- /dev/null +++ b/perp/qrpglesrc/wrkvndr.sqlrpgle @@ -0,0 +1,419 @@ +**free + +// --------------------------------------------------------------------- +// Program: wrkvndr (Work with Vendors -- vendor master maintenance) +// Purpose: DSPF-based CRUD for vendor, scoped by the company selected +// via perpselr (*LDA positions 1-3). Subfile filters by +// active-only and buyer_code. buyer_code FK is enforced by +// DB2 against perp_user; payment_terms_code FK against +// code_master (PAYTERMS) -- typos surface as SQLSTATE 23503 +// on the message subfile. +// Epic: PERP-5 (PERP-29) +// --------------------------------------------------------------------- + +ctl-opt dftactgrp(*no) actgrp(*new); + +dcl-f wrkvndd workstn sfile(vsfl:rrn) sfile(vmsgsfl:msgrrn); + +dcl-ds ldaDS dtaara(*lda) len(1024) qualified; + compcd char(3) pos(1); +end-ds; + +dcl-pr QMHSNDPM extpgm; + msgId char(7) const; + msgF char(20) const; + msgData char(256) const; + msgDataLen int(10) const; + msgType char(10) const; + stackEntry char(10) const; + stackCntr int(10) const; + msgKey char(4); + errorCode char(8) const; +end-pr; + +dcl-ds statusDS psds qualified; + programName char(10) pos(334); +end-ds; + +dcl-ds vndRow qualified; + vcode varchar(10); + vname varchar(60); + vbuyer char(10); + vact char(1); +end-ds; + +dcl-ds rows likeds(vndRow) dim(500); +dcl-s numRows int(10); +dcl-s i int(10); +dcl-s rrn int(10); +dcl-s msgrrn int(10); +dcl-s msgkey char(4); +dcl-s selRrn int(10); +dcl-s selOpt char(1); +dcl-s compcd char(3); +dcl-s fActOnly char(1); +dcl-s fBuyer char(10); +dcl-s holdMsg ind; +dcl-s validationFailed ind; + +in ldaDS; +compcd = ldaDS.compcd; +scompdsp = compcd; +fActOnly = 'N'; +fBuyer = ''; +sfact = 'N'; +sfbuyer = ''; + +if compcd = ''; + exsr clearMsgs; + writeMsg('No company selected - run Select Company (PERPSELR) first.'); +endif; + +dow not *in03 and not *in12; + if compcd = ''; + *in30 = *off; + write vnoco; + write vfoot; + if msgrrn > 0; + *in40 = *on; + write vmsgctl; + else; + *in40 = *off; + endif; + exfmt vctl; + leave; + endif; + + // A message queued by an action handler below (addRow, etc.) must + // survive one full loop pass before being cleared, or it never + // reaches the screen -- clearMsgs wipes msgrrn back to 0 on the very + // next pass, before this pass's own exfmt ever shows it. holdMsg + // skips exactly one clearMsgs call right after such a message was + // queued. Same pattern as wrkitmr. + if holdMsg; + holdMsg = *off; + else; + exsr clearMsgs; + endif; + exsr loadRows; + + if numRows = 0; + *in30 = *off; + write vnone; + else; + exsr fillSubfile; + *in30 = *on; + endif; + + write vfoot; + if msgrrn > 0; + *in40 = *on; + write vmsgctl; + else; + *in40 = *off; + endif; + exfmt vctl; + + if *in03 or *in12; + leave; + endif; + + if *in05; + fActOnly = sfact; + fBuyer = sfbuyer; + iter; + endif; + + if *in06; + exsr addRow; + iter; + endif; + + // Refresh filters from screen entry + if sfact <> fActOnly or sfbuyer <> fBuyer; + fActOnly = sfact; + fBuyer = sfbuyer; + iter; + endif; + + // Process subfile options. Guard on numRows: READC against a subfile + // that was never written to this cycle (0 rows loaded) raises a + // "Session or device error" (CPF5006-class) runtime error instead of + // just returning *EOF. + if numRows > 0; + selRrn = 0; + selOpt = ' '; + readc vsfl; + dow not %eof(wrkvndd); + if sopt <> ''; + selRrn = rrn; + selOpt = sopt; + exsr handleOpt; + selRrn = 0; + endif; + readc vsfl; + enddo; + endif; + +enddo; + +*inlr = *on; +return; + +// --------------------------------------------------------------------- +begsr loadRows; + numRows = 0; + exec sql declare v1 cursor for + select vendor_code, vendor_name, buyer_code, is_active + from perpdemo.vendor + where company_code = :compcd + and (:fActOnly = 'N' or is_active = 'Y') + and (:fBuyer = '' or buyer_code = :fBuyer) + order by vendor_code; + exec sql open v1; + if sqlcode < 0; + writeMsg('SQL open failed: SQLCODE=' + %char(sqlcode)); + holdMsg = *on; + leavesr; + endif; + + dow numRows < %elem(rows); + exec sql fetch v1 into :vndRow; + if sqlcode = 100 or sqlcode < 0; + leave; + endif; + numRows += 1; + rows(numRows) = vndRow; + enddo; + exec sql close v1; +endsr; + +// --------------------------------------------------------------------- +begsr fillSubfile; + rrn = 0; + *in31 = *on; + write vctl; + *in31 = *off; + for i = 1 to numRows; + *in50 = *off; + *in51 = *off; + sopt = ''; + svcode = rows(i).vcode; + svname = rows(i).vname; + svbuyer = rows(i).vbuyer; + svact = rows(i).vact; + rrn += 1; + write vsfl; + endfor; +endsr; + +// --------------------------------------------------------------------- +begsr handleOpt; + chain selRrn vsfl; + if %found(wrkvndd); + select; + when selOpt = '2'; + exsr changeRow; + when selOpt = '4'; + exsr deleteRow; + when selOpt = '5'; + exsr displayRow; + other; + writeMsg('Option ' + selOpt + ' not valid.'); + holdMsg = *on; + endsl; + endif; +endsr; + +// --------------------------------------------------------------------- +begsr addRow; + exsr clearMsgs; + emode = 'A'; + evcode = ''; + evname = ''; + eaddr1 = ''; + eaddr2 = ''; + ecity = ''; + estate = ''; + epostcd = ''; + ecntry = 'US'; + ephone = ''; + eemail = ''; + ecntct = ''; + ebuyer = fBuyer; + epterms = 'NET30'; + etaxid = ''; + eactive = 'Y'; + exsr editLoop; + if not *in12; + exsr validateVendor; + if validationFailed; + holdMsg = *on; + else; + exec sql + insert into perpdemo.vendor + (company_code, vendor_code, vendor_name, address_line1, address_line2, + city_name, state_code, postal_code, country_code, phone_number, + email_address, contact_name, buyer_code, payment_terms_code, tax_id, + is_active) + values (:compcd, :evcode, :evname, :eaddr1, :eaddr2, + :ecity, :estate, :epostcd, :ecntry, :ephone, + :eemail, :ecntct, :ebuyer, :epterms, :etaxid, + :eactive); + if sqlcode < 0; + writeMsg('Add failed: SQLCODE=' + %char(sqlcode) + + ' SQLSTATE=' + sqlstate); + else; + writeMsg('Added ' + %trim(evcode) + '.'); + endif; + holdMsg = *on; + endif; + endif; +endsr; + +// --------------------------------------------------------------------- +begsr changeRow; + exsr clearMsgs; + emode = 'C'; + evcode = svcode; + exec sql + select vendor_name, address_line1, address_line2, city_name, state_code, + postal_code, country_code, phone_number, email_address, + contact_name, buyer_code, payment_terms_code, tax_id, is_active + into :evname, :eaddr1, :eaddr2, :ecity, :estate, + :epostcd, :ecntry, :ephone, :eemail, + :ecntct, :ebuyer, :epterms, :etaxid, :eactive + from perpdemo.vendor + where company_code = :compcd and vendor_code = :evcode; + if sqlcode <> 0; + writeMsg('Row disappeared before change.'); + holdMsg = *on; + leavesr; + endif; + exsr editLoop; + if not *in12; + exsr validateVendor; + if validationFailed; + holdMsg = *on; + else; + exec sql + update perpdemo.vendor + set vendor_name = :evname, + address_line1 = :eaddr1, + address_line2 = :eaddr2, + city_name = :ecity, + state_code = :estate, + postal_code = :epostcd, + country_code = :ecntry, + phone_number = :ephone, + email_address = :eemail, + contact_name = :ecntct, + buyer_code = :ebuyer, + payment_terms_code = :epterms, + tax_id = :etaxid, + is_active = :eactive, + updated_at = current_timestamp, + updated_by = user + where company_code = :compcd and vendor_code = :evcode; + if sqlcode < 0; + writeMsg('Change failed: SQLCODE=' + %char(sqlcode) + + ' SQLSTATE=' + sqlstate); + else; + writeMsg('Updated ' + %trim(evcode) + '.'); + endif; + holdMsg = *on; + endif; + endif; +endsr; + +// --------------------------------------------------------------------- +begsr deleteRow; + exsr clearMsgs; + exec sql + delete from perpdemo.vendor + where company_code = :compcd and vendor_code = :svcode; + if sqlcode < 0; + writeMsg('Delete failed (in use?): SQLSTATE=' + sqlstate); + else; + writeMsg('Deleted ' + %trim(svcode) + '.'); + endif; + holdMsg = *on; +endsr; + +// --------------------------------------------------------------------- +begsr displayRow; + emode = 'D'; + evcode = svcode; + exec sql + select vendor_name, address_line1, address_line2, city_name, state_code, + postal_code, country_code, phone_number, email_address, + contact_name, buyer_code, payment_terms_code, tax_id, is_active + into :evname, :eaddr1, :eaddr2, :ecity, :estate, + :epostcd, :ecntry, :ephone, :eemail, + :ecntct, :ebuyer, :epterms, :etaxid, :eactive + from perpdemo.vendor + where company_code = :compcd and vendor_code = :evcode; + exsr editLoop; +endsr; + +// --------------------------------------------------------------------- +// *in60 conditions DSPATR(PR) on every entry field in VEDIT -- protect +// them in Display mode so 5=Display can't be mistaken for an editable +// screen (it never saves regardless, but the fields must not look +// enterable). +begsr editLoop; + if emode = 'D'; + *in60 = *on; + else; + *in60 = *off; + endif; + exfmt vedit; +endsr; + +// --------------------------------------------------------------------- +// Required-field validation for the Add/Change panel, done here in RPG +// instead of letting a blank required field surface as a raw FK/NOT-NULL +// violation from the database. +begsr validateVendor; + validationFailed = *off; + if %trim(evcode) = ''; + writeMsg('Vendor Code is required.'); + validationFailed = *on; + elseif %trim(evname) = ''; + writeMsg('Vendor Name is required.'); + validationFailed = *on; + elseif %trim(ebuyer) = ''; + writeMsg('Buyer is required.'); + validationFailed = *on; + endif; +endsr; + +// --------------------------------------------------------------------- +begsr clearMsgs; + msgrrn = 0; + *in41 = *on; + write vmsgctl; + *in41 = *off; +endsr; + +// --------------------------------------------------------------------- +dcl-proc writeMsg; + dcl-pi *n; + text varchar(256) const; + end-pi; + dcl-s data char(256); + data = text; + QMHSNDPM( + 'CPF9897' : + 'QCPFMSG QSYS ' : + data : + %len(text) : + '*INFO ' : + '* ' : + 1 : + smsgkey : + x'0000000000000000'); + msgrrn += 1; + spgmq = statusDS.programName; + write vmsgsfl; +end-proc; diff --git a/perp/qsrvsrc/docseq.bnd b/perp/qsrvsrc/docseq.bnd new file mode 100644 index 00000000..f79fff8b --- /dev/null +++ b/perp/qsrvsrc/docseq.bnd @@ -0,0 +1,4 @@ +strpgmexp pgmlvl(*current) signature('DOCSEQ ') + export symbol("DOCSEQ_NEXT") + export symbol("DOCSEQ_PEEK") +endpgmexp diff --git a/perp/qsrvsrc/itmvprcq.bnd b/perp/qsrvsrc/itmvprcq.bnd new file mode 100644 index 00000000..55da5fe8 --- /dev/null +++ b/perp/qsrvsrc/itmvprcq.bnd @@ -0,0 +1,3 @@ +strpgmexp pgmlvl(*current) signature('ITMVPRCQ ') + export symbol("ITMVPRCQ_HISTORY") +endpgmexp diff --git a/perp/qsrvsrc/lotrecon.bnd b/perp/qsrvsrc/lotrecon.bnd new file mode 100644 index 00000000..9677990f --- /dev/null +++ b/perp/qsrvsrc/lotrecon.bnd @@ -0,0 +1,3 @@ +strpgmexp pgmlvl(*current) signature('LOTRECON ') + export symbol("LOTRECON_RUN") +endpgmexp diff --git a/perp/qsrvsrc/reqauto.bnd b/perp/qsrvsrc/reqauto.bnd new file mode 100644 index 00000000..bd51b959 --- /dev/null +++ b/perp/qsrvsrc/reqauto.bnd @@ -0,0 +1,4 @@ +strpgmexp pgmlvl(*current) signature('REQAUTO ') + export symbol("REQAUTO_SCORE") + export symbol("REQAUTO_EVALUATE") +endpgmexp diff --git a/perp/qsrvsrc/whcoord.bnd b/perp/qsrvsrc/whcoord.bnd new file mode 100644 index 00000000..20517cea --- /dev/null +++ b/perp/qsrvsrc/whcoord.bnd @@ -0,0 +1,5 @@ +strpgmexp pgmlvl(*current) signature('WHCOORD ') + export symbol("WHCOORD_OPEN") + export symbol("WHCOORD_FETCH") + export symbol("WHCOORD_CLOSE") +endpgmexp diff --git a/perp/tmp/logs/wrklotr.pgm.log b/perp/tmp/logs/wrklotr.pgm.log new file mode 100644 index 00000000..247d4cf0 --- /dev/null +++ b/perp/tmp/logs/wrklotr.pgm.log @@ -0,0 +1,2799 @@ +CPC7301: File QSQLPRE created in library QTEMP. +CPC7305: Member WRKLOTR added to file QSQLPRE in QTEMP. +CPC3201: Member WRKLOTR file QSQLPRE in QTEMP changed. +RNS9307: Diagnostic check of source is complete. Highest severity is 00. +CPC0904: Data area RETURNCODE created in library QTEMP. +CPC7301: File QSQLTEMP1 created in library QTEMP. +CPC7305: Member WRKLOTR added to file QSQLTEMP1 in QTEMP. +CPI2119: AUT and USRPRF parameter values were ignored. +CPI2121: Replaced object WRKLOTR type *PGM was moved to QRPLOBJ. +RNS9304: Program WRKLOTR placed in library PERPDEMO. 00 highest severity. Created on 08/26/26 at 16:51:51. + 5770WDS V7R5M0 220415 RN IBM ILE RPG PERPDEMO/WRKLOTR IDEV 08/26/26 16:51:50 Page 1 + Command . . . . . . . . . . . . : CRTBNDRPG + Issued by . . . . . . . . . . : AIDEMO + Program . . . . . . . . . . . . : WRKLOTR + Library . . . . . . . . . . . : PERPDEMO + Text 'description' . . . . . . . : *SRCMBRTXT + Source stream file . . . . . . : qrpglesrc/wrklotr.sqlrpgle + CCSID . . . . . . . . . . . . : 1208 + Target CCSID . . . . . . . . . . : *JOB (37) + Text 'description' . . . . . . . : + Last Change . . . . . . . . . . : 08/26/26 16:51:48 + Generation severity level . . . : 10 + Default activation group . . . . : *YES + Compiler options . . . . . . . . : *XREF *GEN *NOSECLVL *SHOWCPY + *EXPDDS *EXT *NOSHOWSKP *NOSRCSTMT + *DEBUGIO *UNREF *NOEVENTF + Debugging views . . . . . . . . : *ALL + Debug encryption key . . . . . . : *NONE + Output . . . . . . . . . . . . . : *PRINT + Optimization level . . . . . . . : *NONE + Source listing indentation . . . : *NONE + Type conversion options . . . . : *NONE + Sort sequence . . . . . . . . . : *JOB + Language identifier . . . . . . : *JOB + Replace program . . . . . . . . : *YES + User profile . . . . . . . . . . : *USER + Authority . . . . . . . . . . . : *LIBCRTAUT + Truncate numeric . . . . . . . . : *YES + Fix numeric . . . . . . . . . . : *NONE + Target release . . . . . . . . . : V7R4M0 + Allow null values . . . . . . . : *NO + Define condition names . . . . . : *NONE + Enable performance collection . : *PEP + Profiling data . . . . . . . . . : *NOCOL + Licensed Internal Code options . : + Generate program interface . . . : *NO + Include directory . . . . . . . : . + Preprocessor options . . . . . . : *NORMVCOMMENT *EXPINCLUDE *NOSEQSRC + Output source file . . . . . . . : QSQLPRE + Library . . . . . . . . . . . : QTEMP + Output source member . . . . . . : WRKLOTR + MINIMUM OUTPUT LINE LENGTH . . . : 100 + Require prototype for export . . : *NO + 5770WDS V7R5M0 220415 RN IBM ILE RPG PERPDEMO/WRKLOTR IDEV 08/26/26 16:51:50 Page 2 + Line <---------------------- Source Specifications -----------------------------------------------------> Do Change Src Seq + Number ....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8....+....9....+...10 Num Date Id Number + S o u r c e L i s t i n g + 1 **free 000001 + 2 000002 + 3 // --------------------------------------------------------------------- 000003 + 4 // Program: wrklotr (Work with Item Lots) 000004 + 5 // Purpose: DSPF-based CRUD for item_lot, scoped by the company selected 000005 + 6 // via perpselr (*LDA positions 1-3) and an item number entered 000006 + 7 // on screen (same scoping idiom as wrkcnvr). Shows item.on_hand 000007 + 8 // alongside SUM(item_lot.qty_on_hand) and flags a discrepancy 000008 + 9 // -- the entry point for the reconciliation demo (Option C: 000009 + 10 // balances denormalized on both item and item_lot by design). 000010 + 11 // Callable standalone or pre-scoped by passing company/item 000011 + 12 // (mirrors wrkcnvr's PERP-23 integration). 000012 + 13 // Epic: PERP-3 (PERP-24) 000013 + 14 // --------------------------------------------------------------------- 000014 + 15 000015 + 16 // PERP-84: datfmt(*iso) is required now that this program declares 000016 + 17 // Date-typed variables (parsedRecv/parsedExpd below) to validate the 000017 + 18 // MM/DD/YY Received/Expiry Date entry fields. Without this override the 000018 + 19 // job's *MDY (1940-2039) DATFMT becomes the Date variables' storage 000019 + 20 // format, per perp/AGENTS.md's RNQ0114 gotcha. 000020 + 21 ctl-opt dftactgrp(*no) actgrp(*new) datfmt(*iso); 000021 + 22 000022 + 23 dcl-pi *n; 000023 + 24 pCompcd char(3) const options(*nopass); 000024 + 25 pItem varchar(25) const options(*nopass); 000025 + 26 end-pi; 000026 + 27 000027 + 28 dcl-f wrklotd workstn sfile(ltsfl:rrn) sfile(ltmsgsfl:msgrrn); 000028 + 29 000029 + 30 dcl-ds ldaDS dtaara(*lda) len(1024) qualified; 000030 + 31 compcd char(3) pos(1); 000031 + 32 end-ds; 000032 + 33 000033 + 34 dcl-pr QMHSNDPM extpgm; 000034 + 35 msgId char(7) const; 000035 + 36 msgF char(20) const; 000036 + 37 msgData char(256) const; 000037 + 38 msgDataLen int(10) const; 000038 + 39 msgType char(10) const; 000039 + 40 stackEntry char(10) const; 000040 + 41 stackCntr int(10) const; 000041 + 42 msgKey char(4); 000042 + 43 errorCode char(8) const; 000043 + 44 end-pr; 000044 + 45 000045 + 46 // Standard, reusable Item Number prompt (PERP-51/PERP-56). Same dynamic 000046 + 47 // CALL idiom as wrkitmr's callWrkcnvr/callWrklotr. 000047 + 48 dcl-pr callItmprmt extpgm('ITMPRMT'); 000048 + 49 pCompcd char(3) const; 000049 + 50 pItem varchar(25); 000050 + 51 end-pr; 000051 + 52 000052 + 53 dcl-ds statusDS psds qualified; 000053 + 5770WDS V7R5M0 220415 RN IBM ILE RPG PERPDEMO/WRKLOTR IDEV 08/26/26 16:51:50 Page 3 + Line <---------------------- Source Specifications -----------------------------------------------------> Do Change Src Seq + Number ....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8....+....9....+...10 Num Date Id Number + 54 programName char(10) pos(334); 000054 + 55 end-ds; 000055 + 56 000056 + 57 dcl-ds ltRow qualified; 000057 + 58 lot varchar(20); 000058 + 59 qty packed(15:4); 000059 + 60 recv varchar(10); 000060 + 61 expd varchar(10); 000061 + 62 end-ds; 000062 + 63 000063 + 64 dcl-ds rows likeds(ltRow) dim(500); 000064 + 65 dcl-s numRows int(10); 000065 + 66 dcl-s i int(10); 000066 + 67 dcl-s rrn int(10); 000067 + 68 dcl-s msgrrn int(10); 000068 + 69 dcl-s msgkey char(4); 000069 + 70 dcl-s selRrn int(10); 000070 + 71 dcl-s selOpt char(1); 000071 + 72 dcl-s filter varchar(25); 000072 + 73 dcl-s compcd char(3); 000073 + 74 dcl-s itemOh packed(15:4); 000074 + 75 dcl-s lotTotal packed(15:4); 000075 + 76 dcl-s promptItem varchar(25); 000076 + 77 dcl-s holdMsg ind; 000077 + 78 000078 + 79 // PERP-84: MM/DD/YY entry validation for ERECV/EEXPD (see editLoop). 000079 + 80 // parsedRecv/parsedExpd are Date-typed working vars used only to 000080 + 81 // validate/reformat the typed text -- they are never bound directly to 000081 + 82 // an SQL host variable (erecv/eexpd stay char(10) for that), so the 000082 + 83 // SQL-precompiler-intermediate-host-variable *MDY cap documented in 000083 + 84 // perp/AGENTS.md #13 does not come into play here. 000084 + 85 dcl-s parsedRecv date; 000085 + 86 dcl-s parsedExpd date; 000086 + 87 dcl-s validRecv ind; 000087 + 88 dcl-s validExpd ind; 000088 + 89 000089 + 90 in ldaDS; 000090 + 91 compcd = ldaDS.compcd; 000091 + 92 000092 + 93 if %parms >= 1 and pCompcd <> ''; 000093 + 94 compcd = pCompcd; 000094 + 95 endif; 000095 + 96 scompdsp = compcd; 000096 + 97 filter = ''; 000097 + 98 if %parms >= 2 and pItem <> ''; 000098 + 99 filter = pItem; 000099 + 100 sfitem = pItem; 000100 + 101 else; 000101 + 102 sfitem = ''; 000102 + 103 endif; 000103 + 104 000104 + 105 if compcd = ''; 000105 + 106 exsr clearMsgs; 000106 + 107 writeMsg('No company selected - run Select Company (PERPSELR) first.'); 000107 + 108 endif; 000108 + 109 000109 + 5770WDS V7R5M0 220415 RN IBM ILE RPG PERPDEMO/WRKLOTR IDEV 08/26/26 16:51:50 Page 4 + Line <---------------------- Source Specifications -----------------------------------------------------> Do Change Src Seq + Number ....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8....+....9....+...10 Num Date Id Number + 110 dow not *in03 and not *in12; 000110 + 111 if compcd = ''; 000111 + 112 *in30 = *off; 000112 + 113 write ltnoitem; 000113 + 114 write ltfoot; 000114 + 115 if msgrrn > 0; 000115 + 116 *in40 = *on; 000116 + 117 write ltmsgctl; 000117 + 118 else; 000118 + 119 *in40 = *off; 000119 + 120 endif; 000120 + 121 exfmt ltctl; 000121 + 122 leave; 000122 + 123 endif; 000123 + 124 000124 + 125 // A message queued by an action handler below (addRow, etc.) must 000125 + 126 // survive one full loop pass before being cleared, or it never 000126 + 127 // reaches the screen -- clearMsgs wipes msgrrn back to 0 on the very 000127 + 128 // next pass, before this pass's own exfmt ever shows it. holdMsg 000128 + 129 // skips exactly one clearMsgs call right after such a message was 000129 + 130 // queued. Same pattern as wrkitmr. 000130 + 131 if holdMsg; 000131 + 132 holdMsg = *off; 000132 + 133 else; 000133 + 134 exsr clearMsgs; 000134 + 135 endif; 000135 + 136 000136 + 137 if filter = ''; 000137 + 138 *in30 = *off; 000138 + 139 *in60 = *off; 000139 + 140 numRows = 0; 000140 + 141 sioh = 0; 000141 + 142 slottot = 0; 000142 + 143 write ltnoitem; 000143 + 144 else; 000144 + 145 exsr loadBalances; 000145 + 146 exsr loadRows; 000146 + 147 if numRows = 0; 000147 + 148 *in30 = *off; 000148 + 149 write ltnone; 000149 + 150 else; 000150 + 151 exsr fillSubfile; 000151 + 152 *in30 = *on; 000152 + 153 endif; 000153 + 154 endif; 000154 + 155 000155 + 156 write ltfoot; 000156 + 157 if msgrrn > 0; 000157 + 158 *in40 = *on; 000158 + 159 write ltmsgctl; 000159 + 160 else; 000160 + 161 *in40 = *off; 000161 + 162 endif; 000162 + 163 exfmt ltctl; 000163 + 164 000164 + 165 if *in03 or *in12; 000165 + 5770WDS V7R5M0 220415 RN IBM ILE RPG PERPDEMO/WRKLOTR IDEV 08/26/26 16:51:50 Page 5 + Line <---------------------- Source Specifications -----------------------------------------------------> Do Change Src Seq + Number ....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8....+....9....+...10 Num Date Id Number + 166 leave; 000166 + 167 endif; 000167 + 168 000168 + 169 if *in05; 000169 + 170 filter = sfitem; 000170 + 171 iter; 000171 + 172 endif; 000172 + 173 000173 + 174 if *in06; 000174 + 175 if sfitem = ''; 000175 + 176 writeMsg('Enter an item number before adding a lot.'); 000176 + 177 holdMsg = *on; 000177 + 178 else; 000178 + 179 filter = sfitem; 000179 + 180 exsr addRow; 000180 + 181 endif; 000181 + 182 iter; 000182 + 183 endif; 000183 + 184 000184 + 185 // Item Number prompt (PERP-60): '?' + Enter invokes the standard 000185 + 186 // reusable Item Number lookup (PERP-56) and returns the selection. 000186 + 187 if %trim(sfitem) = '?'; 000187 + 188 promptItem = sfitem; 000188 + 189 callItmprmt(compcd : promptItem); 000189 + 190 sfitem = promptItem; 000190 + 191 filter = promptItem; 000191 + 192 iter; 000192 + 193 endif; 000193 + 194 000194 + 195 // Refresh scope from screen entry 000195 + 196 if sfitem <> filter; 000196 + 197 filter = sfitem; 000197 + 198 iter; 000198 + 199 endif; 000199 + 200 000200 + 201 // Process subfile options. Guard on numRows: READC against a subfile 000201 + 202 // that was never written to this cycle (0 rows loaded) raises a 000202 + 203 // "Session or device error" (CPF5006-class) runtime error instead of 000203 + 204 // just returning *EOF. 000204 + 205 if numRows > 0; 000205 + 206 selRrn = 0; 000206 + 207 selOpt = ' '; 000207 + 208 readc ltsfl; 000208 + 209 dow not %eof(wrklotd); 000209 + 210 if sopt <> ''; 000210 + 211 selRrn = rrn; 000211 + 212 selOpt = sopt; 000212 + 213 exsr handleOpt; 000213 + 214 selRrn = 0; 000214 + 215 endif; 000215 + 216 readc ltsfl; 000216 + 217 enddo; 000217 + 218 endif; 000218 + 219 000219 + 220 enddo; 000220 + 221 000221 + 5770WDS V7R5M0 220415 RN IBM ILE RPG PERPDEMO/WRKLOTR IDEV 08/26/26 16:51:50 Page 6 + Line <---------------------- Source Specifications -----------------------------------------------------> Do Change Src Seq + Number ....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8....+....9....+...10 Num Date Id Number + 222 *inlr = *on; 000222 + 223 return; 000223 + 224 000224 + 225 // --------------------------------------------------------------------- 000225 + 226 begsr loadBalances; 000226 + 227 exec sql 000227 + 228 select qty_on_hand into :itemOh 000228 + 229 from perpdemo.item 000229 + 230 where company_code = :compcd and item_number = :filter; 000230 + 231 if sqlcode <> 0; 000231 + 232 itemOh = 0; 000232 + 233 endif; 000233 + 234 exec sql 000234 + 235 select coalesce(sum(qty_on_hand), 0) into :lotTotal 000235 + 236 from perpdemo.item_lot 000236 + 237 where company_code = :compcd and item_number = :filter; 000237 + 238 sioh = itemOh; 000238 + 239 slottot = lotTotal; 000239 + 240 if itemOh <> lotTotal; 000240 + 241 *in60 = *on; 000241 + 242 else; 000242 + 243 *in60 = *off; 000243 + 244 endif; 000244 + 245 endsr; 000245 + 246 000246 + 247 // --------------------------------------------------------------------- 000247 + 248 begsr loadRows; 000248 + 249 numRows = 0; 000249 + 250 // PERP-84: display as MM/DD/YY. received_date/expiry_date are stored 000250 + 251 // as native DATE columns but rendered here as plain strings (SRECV/ 000251 + 252 // SEXPD carry no DATFMT keyword), so the format has to be built by 000252 + 253 // hand from the ISO string -- DB2 for i's CHAR(date,fmt) built-in 000253 + 254 // formats (ISO/USA/EUR/JIS) all use a 4-digit year, none produce a 000254 + 255 // 2-digit year directly. Same technique as wrkivpr.sqlrpgle (PERP-83). 000255 + 256 exec sql declare c1 cursor for 000256 + 257 select lot_number, qty_on_hand, 000257 + 258 substr(char(received_date, iso), 6, 2) || '/' 000258 + 259 || substr(char(received_date, iso), 9, 2) || '/' 000259 + 260 || substr(char(received_date, iso), 3, 2), 000260 + 261 case when expiry_date is null then '' 000261 + 262 else substr(char(expiry_date, iso), 6, 2) || '/' 000262 + 263 || substr(char(expiry_date, iso), 9, 2) || '/' 000263 + 264 || substr(char(expiry_date, iso), 3, 2) 000264 + 265 end 000265 + 266 from perpdemo.item_lot 000266 + 267 where company_code = :compcd and item_number = :filter 000267 + 268 order by lot_number; 000268 + 269 exec sql open c1; 000269 + 270 if sqlcode < 0; 000270 + 271 writeMsg('SQL open failed: SQLCODE=' + %char(sqlcode)); 000271 + 272 leavesr; 000272 + 273 endif; 000273 + 274 000274 + 275 dow numRows < %elem(rows); 000275 + 276 exec sql fetch c1 into :ltRow; 000276 + 277 if sqlcode = 100 or sqlcode < 0; 000277 + 5770WDS V7R5M0 220415 RN IBM ILE RPG PERPDEMO/WRKLOTR IDEV 08/26/26 16:51:50 Page 7 + Line <---------------------- Source Specifications -----------------------------------------------------> Do Change Src Seq + Number ....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8....+....9....+...10 Num Date Id Number + 278 leave; 000278 + 279 endif; 000279 + 280 numRows += 1; 000280 + 281 rows(numRows) = ltRow; 000281 + 282 enddo; 000282 + 283 exec sql close c1; 000283 + 284 endsr; 000284 + 285 000285 + 286 // --------------------------------------------------------------------- 000286 + 287 begsr fillSubfile; 000287 + 288 rrn = 0; 000288 + 289 *in31 = *on; 000289 + 290 write ltctl; 000290 + 291 *in31 = *off; 000291 + 292 for i = 1 to numRows; 000292 + 293 *in50 = *off; 000293 + 294 *in51 = *off; 000294 + 295 sopt = ''; 000295 + 296 slot = rows(i).lot; 000296 + 297 sqty = rows(i).qty; 000297 + 298 srecv = rows(i).recv; 000298 + 299 sexpd = rows(i).expd; 000299 + 300 rrn += 1; 000300 + 301 write ltsfl; 000301 + 302 endfor; 000302 + 303 endsr; 000303 + 304 000304 + 305 // --------------------------------------------------------------------- 000305 + 306 begsr handleOpt; 000306 + 307 chain selRrn ltsfl; 000307 + 308 if %found(wrklotd); 000308 + 309 select; 000309 + 310 when selOpt = '2'; 000310 + 311 exsr changeRow; 000311 + 312 when selOpt = '4'; 000312 + 313 exsr deleteRow; 000313 + 314 other; 000314 + 315 writeMsg('Option ' + selOpt + ' not valid.'); 000315 + 316 holdMsg = *on; 000316 + 317 endsl; 000317 + 318 endif; 000318 + 319 endsr; 000319 + 320 000320 + 321 // --------------------------------------------------------------------- 000321 + 322 begsr addRow; 000322 + 323 exsr clearMsgs; 000323 + 324 emode = 'A'; 000324 + 325 elot = ''; 000325 + 326 eqty = 0; 000326 + 327 erecv = %char(%date():*mdy); 000327 + 328 eexpd = ''; 000328 + 329 eactive = 'Y'; 000329 + 330 exsr editLoop; 000330 + 331 if not *in12 and elot <> ''; 000331 + 332 exec sql 000332 + 333 insert into perpdemo.item_lot 000333 + 5770WDS V7R5M0 220415 RN IBM ILE RPG PERPDEMO/WRKLOTR IDEV 08/26/26 16:51:50 Page 8 + Line <---------------------- Source Specifications -----------------------------------------------------> Do Change Src Seq + Number ....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8....+....9....+...10 Num Date Id Number + 334 (company_code, item_number, lot_number, qty_on_hand, received_date, expiry_date) 000334 + 335 values (:compcd, :filter, :elot, :eqty, date(:erecv), 000335 + 336 case when :eexpd = '' then null else date(:eexpd) end); 000336 + 337 if sqlcode < 0; 000337 + 338 writeMsg('Add failed: SQLCODE=' + %char(sqlcode) 000338 + 339 + ' SQLSTATE=' + sqlstate); 000339 + 340 else; 000340 + 341 writeMsg('Added lot ' + %trim(elot) + '.'); 000341 + 342 endif; 000342 + 343 holdMsg = *on; 000343 + 344 endif; 000344 + 345 endsr; 000345 + 346 000346 + 347 // --------------------------------------------------------------------- 000347 + 348 begsr changeRow; 000348 + 349 exsr clearMsgs; 000349 + 350 emode = 'C'; 000350 + 351 elot = slot; 000351 + 352 eqty = sqty; 000352 + 353 erecv = srecv; 000353 + 354 eexpd = sexpd; 000354 + 355 eactive = 'Y'; 000355 + 356 exsr editLoop; 000356 + 357 if not *in12; 000357 + 358 exec sql 000358 + 359 update perpdemo.item_lot 000359 + 360 set qty_on_hand = :eqty, 000360 + 361 received_date = date(:erecv), 000361 + 362 expiry_date = case when :eexpd = '' then null else date(:eexpd) end, 000362 + 363 updated_at = current_timestamp, 000363 + 364 updated_by = user 000364 + 365 where company_code = :compcd and item_number = :filter and lot_number = :elot; 000365 + 366 if sqlcode < 0; 000366 + 367 writeMsg('Change failed: SQLCODE=' + %char(sqlcode)); 000367 + 368 else; 000368 + 369 writeMsg('Updated lot ' + %trim(elot) + '.'); 000369 + 370 endif; 000370 + 371 holdMsg = *on; 000371 + 372 endif; 000372 + 373 endsr; 000373 + 374 000374 + 375 // --------------------------------------------------------------------- 000375 + 376 begsr deleteRow; 000376 + 377 exsr clearMsgs; 000377 + 378 exec sql 000378 + 379 delete from perpdemo.item_lot 000379 + 380 where company_code = :compcd and item_number = :filter and lot_number = :slot; 000380 + 381 if sqlcode < 0; 000381 + 382 writeMsg('Delete failed: SQLSTATE=' + sqlstate); 000382 + 383 else; 000383 + 384 writeMsg('Deleted lot ' + %trim(slot) + '.'); 000384 + 385 endif; 000385 + 386 holdMsg = *on; 000386 + 387 endsr; 000387 + 388 000388 + 389 // --------------------------------------------------------------------- 000389 + 5770WDS V7R5M0 220415 RN IBM ILE RPG PERPDEMO/WRKLOTR IDEV 08/26/26 16:51:50 Page 9 + Line <---------------------- Source Specifications -----------------------------------------------------> Do Change Src Seq + Number ....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8....+....9....+...10 Num Date Id Number + 390 // PERP-84: erecv/eexpd are typed by the user as MM/DD/YY on LTEDIT. 000390 + 391 // Validate on every Enter; on failure, show the error in the message 000391 + 392 // subfile alongside LTEDIT and let the user retry (never crash into 000392 + 393 // the SQL date(:erecv) cast in addRow/changeRow with unparsed text). 000393 + 394 // On success, erecv/eexpd are normalized to ISO ('yyyy-mm-dd') text so 000394 + 395 // the existing date(:erecv)/date(:eexpd) SQL casts in addRow/changeRow 000395 + 396 // keep working unchanged. 000396 + 397 begsr editLoop; 000397 + 398 exsr clearMsgs; 000398 + 399 dow *on; 000399 + 400 if msgrrn > 0; 000400 + 401 *in40 = *on; 000401 + 402 write ltmsgctl; 000402 + 403 else; 000403 + 404 *in40 = *off; 000404 + 405 endif; 000405 + 406 exfmt ltedit; 000406 + 407 000407 + 408 if *in12; 000408 + 409 leave; 000409 + 410 endif; 000410 + 411 000411 + 412 exsr clearMsgs; 000412 + 413 000413 + 414 if %trim(elot) = ''; 000414 + 415 writeMsg('Lot Number is required.'); 000415 + 416 iter; 000416 + 417 endif; 000417 + 418 000418 + 419 if %trim(erecv) = ''; 000419 + 420 writeMsg('Received Date is required (MM/DD/YY).'); 000420 + 421 iter; 000421 + 422 endif; 000422 + 423 000423 + 424 validRecv = *on; 000424 + 425 monitor; 000425 + 426 parsedRecv = %date(%trim(erecv):*mdy); 000426 + 427 on-error; 000427 + 428 validRecv = *off; 000428 + 429 endmon; 000429 + 430 if not validRecv; 000430 + 431 writeMsg('Invalid Received Date - enter as MM/DD/YY.'); 000431 + 432 iter; 000432 + 433 endif; 000433 + 434 000434 + 435 validExpd = *on; 000435 + 436 if %trim(eexpd) <> ''; 000436 + 437 monitor; 000437 + 438 parsedExpd = %date(%trim(eexpd):*mdy); 000438 + 439 on-error; 000439 + 440 validExpd = *off; 000440 + 441 endmon; 000441 + 442 endif; 000442 + 443 if not validExpd; 000443 + 444 writeMsg('Invalid Expiry Date - enter as MM/DD/YY, or blank for none.'); 000444 + 445 iter; 000445 + 5770WDS V7R5M0 220415 RN IBM ILE RPG PERPDEMO/WRKLOTR IDEV 08/26/26 16:51:50 Page 10 + Line <---------------------- Source Specifications -----------------------------------------------------> Do Change Src Seq + Number ....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8....+....9....+...10 Num Date Id Number + 446 endif; 000446 + 447 000447 + 448 erecv = %char(parsedRecv:*iso); 000448 + 449 if %trim(eexpd) <> ''; 000449 + 450 eexpd = %char(parsedExpd:*iso); 000450 + 451 endif; 000451 + 452 000452 + 453 leave; 000453 + 454 enddo; 000454 + 455 endsr; 000455 + 456 000456 + 457 // --------------------------------------------------------------------- 000457 + 458 begsr clearMsgs; 000458 + 459 msgrrn = 0; 000459 + 460 *in41 = *on; 000460 + 461 write ltmsgctl; 000461 + 462 *in41 = *off; 000462 + 463 endsr; 000463 + 464 000464 + 465 // --------------------------------------------------------------------- 000465 + 466 dcl-proc writeMsg; 000466 + 467 dcl-pi *n; 000467 + 468 text varchar(256) const; 000468 + 469 end-pi; 000469 + 470 dcl-s data char(256); 000470 + 471 data = text; 000471 + 472 QMHSNDPM( 000472 + 473 'CPF9897' : 000473 + 474 'QCPFMSG QSYS ' : 000474 + 475 data : 000475 + 476 %len(text) : 000476 + 477 '*INFO ' : 000477 + 478 '* ' : 000478 + 479 1 : 000479 + 480 smsgkey : 000480 + 481 x'0000000000000000'); 000481 + 482 msgrrn += 1; 000482 + 483 spgmq = statusDS.programName; 000483 + 484 write ltmsgsfl; 000484 + 485 end-proc; 000485 + * * * * * E N D O F S O U R C E * * * * * + 5770WDS V7R5M0 220415 RN IBM ILE RPG PERPDEMO/WRKLOTR IDEV 08/26/26 16:51:50 Page 11 + Line <---------------------- Data Records --------------------------------------------------------------> Change Src Seq + Number ....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8....+....9....+...10 Date Id Number + C o m p i l e T i m e D a t a + * * * * * E N D O F C O M P I L E T I M E D A T A * * * * * + 5770WDS V7R5M0 220415 RN IBM ILE RPG PERPDEMO/WRKLOTR IDEV 08/26/26 16:51:50 Page 12 + M e s s a g e S u m m a r y + Msg id Sv Number Message text + * * * * * E N D O F M E S S A G E S U M M A R Y * * * * * + 5770WDS V7R5M0 220415 RN IBM ILE RPG PERPDEMO/WRKLOTR IDEV 08/26/26 16:51:50 Page 13 + F i n a l S u m m a r y + Message Totals: + Information (00) . . . . . . . : 0 + Warning (10) . . . . . . . : 0 + Error (20) . . . . . . . : 0 + Severe Error (30+) . . . . . . : 0 + --------------------------------- ------- + Total . . . . . . . . . . . . . : 0 + Source Totals: + Records . . . . . . . . . . . . : 485 + Specifications . . . . . . . . : 376 + Data records . . . . . . . . . : 0 + Comments . . . . . . . . . . . : 106 + * * * * * E N D O F F I N A L S U M M A R Y * * * * * + Diagnostic check of source is complete. Highest severity is 00. + * * * * * E N D O F C O M P I L A T I O N * * * * * + 5770ST1 V7R5M0 220415 Create SQL ILE RPG Object WRKLOTR 08/26/26 16:51:50 Page 1 + Source type...............RPG + Object name...............PERPDEMO/WRKLOTR + Source file...............QTEMP/QSQLPRE + Member....................*OBJ + To source file............QTEMP/QSQLTEMP1 + Options...................*XREF + RPG preprocessor options..*LVL2 + Listing option............*PRINT + Target release............V7R4M0 + INCLUDE file..............*LIBL/QRPGLESRC + Commit....................*CHG + Allow copy of data........*OPTIMIZE + Close SQL cursor..........*ENDACTGRP + Allow blocking............*ALLREAD + Delay PREPARE.............*NO + Concurrent access + resolution..............*DFT + Generation level..........10 + Printer file..............*LIBL/QSYSPRT + Date format...............*JOB + Date separator............*JOB + Time format...............*HMS + Time separator ...........*JOB + Replace...................*YES + Relational database.......*LOCAL + User .....................*CURRENT + RDB connect method........*DUW + Default collection........*NONE + Dynamic default + collection..............*NO + Package name..............*OBJLIB/*OBJ + Path......................*NAMING + SQL rules.................*DB2 + Created object type.......*PGM + Debugging view............*SOURCE + Debugging encryption key..*NONE + User profile .............*NAMING + Dynamic user profile......*USER + Sort sequence.............*JOB + Language ID...............*JOB + IBM SQL flagging..........*NOFLAG + ANS flagging..............*NONE + Text......................*SRCMBRTXT + Source file CCSID.........37 + Conversion CCSID..........1208 + Job CCSID.................37 + Decimal result options: + Maximum precision.......31 + Maximum scale...........31 + Minimum divide scale....0 + DECFLOAT rounding mode....*HALFEVEN + Compiler options..........incdir('.') tgtccsid(*job) output(*print) + Source member changed on 08/26/26 16:51:50 + 5770ST1 V7R5M0 220415 Create SQL ILE RPG Object WRKLOTR 08/26/26 16:51:50 Page 2 + Record *...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+... 9 ...+... 0 SEQNBR Last change + 1 **free 000001 08/26/26 + 2 000002 08/26/26 + 3 // --------------------------------------------------------------------- 000003 08/26/26 + 4 // Program: wrklotr (Work with Item Lots) 000004 08/26/26 + 5 // Purpose: DSPF-based CRUD for item_lot, scoped by the company selected 000005 08/26/26 + 6 // via perpselr (*LDA positions 1-3) and an item number entered 000006 08/26/26 + 7 // on screen (same scoping idiom as wrkcnvr). Shows item.on_hand 000007 08/26/26 + 8 // alongside SUM(item_lot.qty_on_hand) and flags a discrepancy 000008 08/26/26 + 9 // -- the entry point for the reconciliation demo (Option C: 000009 08/26/26 + 10 // balances denormalized on both item and item_lot by design). 000010 08/26/26 + 11 // Callable standalone or pre-scoped by passing company/item 000011 08/26/26 + 12 // (mirrors wrkcnvr's PERP-23 integration). 000012 08/26/26 + 13 // Epic: PERP-3 (PERP-24) 000013 08/26/26 + 14 // --------------------------------------------------------------------- 000014 08/26/26 + 15 000015 08/26/26 + 16 // PERP-84: datfmt(*iso) is required now that this program declares 000016 08/26/26 + 17 // Date-typed variables (parsedRecv/parsedExpd below) to validate the 000017 08/26/26 + 18 // MM/DD/YY Received/Expiry Date entry fields. Without this override the 000018 08/26/26 + 19 // job's *MDY (1940-2039) DATFMT becomes the Date variables' storage 000019 08/26/26 + 20 // format, per perp/AGENTS.md's RNQ0114 gotcha. 000020 08/26/26 + 21 ctl-opt dftactgrp(*no) actgrp(*new) datfmt(*iso); 000021 08/26/26 + 22 000022 08/26/26 + 23 dcl-pi *n; 000023 08/26/26 + 24 pCompcd char(3) const options(*nopass); 000024 08/26/26 + 25 pItem varchar(25) const options(*nopass); 000025 08/26/26 + 26 end-pi; 000026 08/26/26 + 27 000027 08/26/26 + 28 dcl-f wrklotd workstn sfile(ltsfl:rrn) sfile(ltmsgsfl:msgrrn); 000028 08/26/26 + 29 000029 08/26/26 + 30 dcl-ds ldaDS dtaara(*lda) len(1024) qualified; 000030 08/26/26 + 31 compcd char(3) pos(1); 000031 08/26/26 + 32 end-ds; 000032 08/26/26 + 33 000033 08/26/26 + 34 dcl-pr QMHSNDPM extpgm; 000034 08/26/26 + 35 msgId char(7) const; 000035 08/26/26 + 36 msgF char(20) const; 000036 08/26/26 + 37 msgData char(256) const; 000037 08/26/26 + 38 msgDataLen int(10) const; 000038 08/26/26 + 39 msgType char(10) const; 000039 08/26/26 + 40 stackEntry char(10) const; 000040 08/26/26 + 41 stackCntr int(10) const; 000041 08/26/26 + 42 msgKey char(4); 000042 08/26/26 + 43 errorCode char(8) const; 000043 08/26/26 + 44 end-pr; 000044 08/26/26 + 45 000045 08/26/26 + 46 // Standard, reusable Item Number prompt (PERP-51/PERP-56). Same dynamic 000046 08/26/26 + 47 // CALL idiom as wrkitmr's callWrkcnvr/callWrklotr. 000047 08/26/26 + 48 dcl-pr callItmprmt extpgm('ITMPRMT'); 000048 08/26/26 + 49 pCompcd char(3) const; 000049 08/26/26 + 50 pItem varchar(25); 000050 08/26/26 + 51 end-pr; 000051 08/26/26 + 52 000052 08/26/26 + 53 dcl-ds statusDS psds qualified; 000053 08/26/26 + 54 programName char(10) pos(334); 000054 08/26/26 + 55 end-ds; 000055 08/26/26 + 56 000056 08/26/26 + 5770ST1 V7R5M0 220415 Create SQL ILE RPG Object WRKLOTR 08/26/26 16:51:50 Page 3 + Record *...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+... 9 ...+... 0 SEQNBR Last change + 57 dcl-ds ltRow qualified; 000057 08/26/26 + 58 lot varchar(20); 000058 08/26/26 + 59 qty packed(15:4); 000059 08/26/26 + 60 recv varchar(10); 000060 08/26/26 + 61 expd varchar(10); 000061 08/26/26 + 62 end-ds; 000062 08/26/26 + 63 000063 08/26/26 + 64 dcl-ds rows likeds(ltRow) dim(500); 000064 08/26/26 + 65 dcl-s numRows int(10); 000065 08/26/26 + 66 dcl-s i int(10); 000066 08/26/26 + 67 dcl-s rrn int(10); 000067 08/26/26 + 68 dcl-s msgrrn int(10); 000068 08/26/26 + 69 dcl-s msgkey char(4); 000069 08/26/26 + 70 dcl-s selRrn int(10); 000070 08/26/26 + 71 dcl-s selOpt char(1); 000071 08/26/26 + 72 dcl-s filter varchar(25); 000072 08/26/26 + 73 dcl-s compcd char(3); 000073 08/26/26 + 74 dcl-s itemOh packed(15:4); 000074 08/26/26 + 75 dcl-s lotTotal packed(15:4); 000075 08/26/26 + 76 dcl-s promptItem varchar(25); 000076 08/26/26 + 77 dcl-s holdMsg ind; 000077 08/26/26 + 78 000078 08/26/26 + 79 // PERP-84: MM/DD/YY entry validation for ERECV/EEXPD (see editLoop). 000079 08/26/26 + 80 // parsedRecv/parsedExpd are Date-typed working vars used only to 000080 08/26/26 + 81 // validate/reformat the typed text -- they are never bound directly to 000081 08/26/26 + 82 // an SQL host variable (erecv/eexpd stay char(10) for that), so the 000082 08/26/26 + 83 // SQL-precompiler-intermediate-host-variable *MDY cap documented in 000083 08/26/26 + 84 // perp/AGENTS.md #13 does not come into play here. 000084 08/26/26 + 85 dcl-s parsedRecv date; 000085 08/26/26 + 86 dcl-s parsedExpd date; 000086 08/26/26 + 87 dcl-s validRecv ind; 000087 08/26/26 + 88 dcl-s validExpd ind; 000088 08/26/26 + 89 000089 08/26/26 + 90 in ldaDS; 000090 08/26/26 + 91 compcd = ldaDS.compcd; 000091 08/26/26 + 92 000092 08/26/26 + 93 if %parms >= 1 and pCompcd <> ''; 000093 08/26/26 + 94 compcd = pCompcd; 000094 08/26/26 + 95 endif; 000095 08/26/26 + 96 scompdsp = compcd; 000096 08/26/26 + 97 filter = ''; 000097 08/26/26 + 98 if %parms >= 2 and pItem <> ''; 000098 08/26/26 + 99 filter = pItem; 000099 08/26/26 + 100 sfitem = pItem; 000100 08/26/26 + 101 else; 000101 08/26/26 + 102 sfitem = ''; 000102 08/26/26 + 103 endif; 000103 08/26/26 + 104 000104 08/26/26 + 105 if compcd = ''; 000105 08/26/26 + 106 exsr clearMsgs; 000106 08/26/26 + 107 writeMsg('No company selected - run Select Company (PERPSELR) first.'); 000107 08/26/26 + 108 endif; 000108 08/26/26 + 109 000109 08/26/26 + 110 dow not *in03 and not *in12; 000110 08/26/26 + 111 if compcd = ''; 000111 08/26/26 + 112 *in30 = *off; 000112 08/26/26 + 5770ST1 V7R5M0 220415 Create SQL ILE RPG Object WRKLOTR 08/26/26 16:51:50 Page 4 + Record *...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+... 9 ...+... 0 SEQNBR Last change + 113 write ltnoitem; 000113 08/26/26 + 114 write ltfoot; 000114 08/26/26 + 115 if msgrrn > 0; 000115 08/26/26 + 116 *in40 = *on; 000116 08/26/26 + 117 write ltmsgctl; 000117 08/26/26 + 118 else; 000118 08/26/26 + 119 *in40 = *off; 000119 08/26/26 + 120 endif; 000120 08/26/26 + 121 exfmt ltctl; 000121 08/26/26 + 122 leave; 000122 08/26/26 + 123 endif; 000123 08/26/26 + 124 000124 08/26/26 + 125 // A message queued by an action handler below (addRow, etc.) must 000125 08/26/26 + 126 // survive one full loop pass before being cleared, or it never 000126 08/26/26 + 127 // reaches the screen -- clearMsgs wipes msgrrn back to 0 on the very 000127 08/26/26 + 128 // next pass, before this pass's own exfmt ever shows it. holdMsg 000128 08/26/26 + 129 // skips exactly one clearMsgs call right after such a message was 000129 08/26/26 + 130 // queued. Same pattern as wrkitmr. 000130 08/26/26 + 131 if holdMsg; 000131 08/26/26 + 132 holdMsg = *off; 000132 08/26/26 + 133 else; 000133 08/26/26 + 134 exsr clearMsgs; 000134 08/26/26 + 135 endif; 000135 08/26/26 + 136 000136 08/26/26 + 137 if filter = ''; 000137 08/26/26 + 138 *in30 = *off; 000138 08/26/26 + 139 *in60 = *off; 000139 08/26/26 + 140 numRows = 0; 000140 08/26/26 + 141 sioh = 0; 000141 08/26/26 + 142 slottot = 0; 000142 08/26/26 + 143 write ltnoitem; 000143 08/26/26 + 144 else; 000144 08/26/26 + 145 exsr loadBalances; 000145 08/26/26 + 146 exsr loadRows; 000146 08/26/26 + 147 if numRows = 0; 000147 08/26/26 + 148 *in30 = *off; 000148 08/26/26 + 149 write ltnone; 000149 08/26/26 + 150 else; 000150 08/26/26 + 151 exsr fillSubfile; 000151 08/26/26 + 152 *in30 = *on; 000152 08/26/26 + 153 endif; 000153 08/26/26 + 154 endif; 000154 08/26/26 + 155 000155 08/26/26 + 156 write ltfoot; 000156 08/26/26 + 157 if msgrrn > 0; 000157 08/26/26 + 158 *in40 = *on; 000158 08/26/26 + 159 write ltmsgctl; 000159 08/26/26 + 160 else; 000160 08/26/26 + 161 *in40 = *off; 000161 08/26/26 + 162 endif; 000162 08/26/26 + 163 exfmt ltctl; 000163 08/26/26 + 164 000164 08/26/26 + 165 if *in03 or *in12; 000165 08/26/26 + 166 leave; 000166 08/26/26 + 167 endif; 000167 08/26/26 + 168 000168 08/26/26 + 5770ST1 V7R5M0 220415 Create SQL ILE RPG Object WRKLOTR 08/26/26 16:51:50 Page 5 + Record *...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+... 9 ...+... 0 SEQNBR Last change + 169 if *in05; 000169 08/26/26 + 170 filter = sfitem; 000170 08/26/26 + 171 iter; 000171 08/26/26 + 172 endif; 000172 08/26/26 + 173 000173 08/26/26 + 174 if *in06; 000174 08/26/26 + 175 if sfitem = ''; 000175 08/26/26 + 176 writeMsg('Enter an item number before adding a lot.'); 000176 08/26/26 + 177 holdMsg = *on; 000177 08/26/26 + 178 else; 000178 08/26/26 + 179 filter = sfitem; 000179 08/26/26 + 180 exsr addRow; 000180 08/26/26 + 181 endif; 000181 08/26/26 + 182 iter; 000182 08/26/26 + 183 endif; 000183 08/26/26 + 184 000184 08/26/26 + 185 // Item Number prompt (PERP-60): '?' + Enter invokes the standard 000185 08/26/26 + 186 // reusable Item Number lookup (PERP-56) and returns the selection. 000186 08/26/26 + 187 if %trim(sfitem) = '?'; 000187 08/26/26 + 188 promptItem = sfitem; 000188 08/26/26 + 189 callItmprmt(compcd : promptItem); 000189 08/26/26 + 190 sfitem = promptItem; 000190 08/26/26 + 191 filter = promptItem; 000191 08/26/26 + 192 iter; 000192 08/26/26 + 193 endif; 000193 08/26/26 + 194 000194 08/26/26 + 195 // Refresh scope from screen entry 000195 08/26/26 + 196 if sfitem <> filter; 000196 08/26/26 + 197 filter = sfitem; 000197 08/26/26 + 198 iter; 000198 08/26/26 + 199 endif; 000199 08/26/26 + 200 000200 08/26/26 + 201 // Process subfile options. Guard on numRows: READC against a subfile 000201 08/26/26 + 202 // that was never written to this cycle (0 rows loaded) raises a 000202 08/26/26 + 203 // "Session or device error" (CPF5006-class) runtime error instead of 000203 08/26/26 + 204 // just returning *EOF. 000204 08/26/26 + 205 if numRows > 0; 000205 08/26/26 + 206 selRrn = 0; 000206 08/26/26 + 207 selOpt = ' '; 000207 08/26/26 + 208 readc ltsfl; 000208 08/26/26 + 209 dow not %eof(wrklotd); 000209 08/26/26 + 210 if sopt <> ''; 000210 08/26/26 + 211 selRrn = rrn; 000211 08/26/26 + 212 selOpt = sopt; 000212 08/26/26 + 213 exsr handleOpt; 000213 08/26/26 + 214 selRrn = 0; 000214 08/26/26 + 215 endif; 000215 08/26/26 + 216 readc ltsfl; 000216 08/26/26 + 217 enddo; 000217 08/26/26 + 218 endif; 000218 08/26/26 + 219 000219 08/26/26 + 220 enddo; 000220 08/26/26 + 221 000221 08/26/26 + 222 *inlr = *on; 000222 08/26/26 + 223 return; 000223 08/26/26 + 224 000224 08/26/26 + 5770ST1 V7R5M0 220415 Create SQL ILE RPG Object WRKLOTR 08/26/26 16:51:50 Page 6 + Record *...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+... 9 ...+... 0 SEQNBR Last change + 225 // --------------------------------------------------------------------- 000225 08/26/26 + 226 begsr loadBalances; 000226 08/26/26 + 227 exec sql 000227 08/26/26 + 228 select qty_on_hand into :itemOh 000228 08/26/26 + 229 from perpdemo.item 000229 08/26/26 + 230 where company_code = :compcd and item_number = :filter; 000230 08/26/26 + 231 if sqlcode <> 0; 000231 08/26/26 + 232 itemOh = 0; 000232 08/26/26 + 233 endif; 000233 08/26/26 + 234 exec sql 000234 08/26/26 + 235 select coalesce(sum(qty_on_hand), 0) into :lotTotal 000235 08/26/26 + 236 from perpdemo.item_lot 000236 08/26/26 + 237 where company_code = :compcd and item_number = :filter; 000237 08/26/26 + 238 sioh = itemOh; 000238 08/26/26 + 239 slottot = lotTotal; 000239 08/26/26 + 240 if itemOh <> lotTotal; 000240 08/26/26 + 241 *in60 = *on; 000241 08/26/26 + 242 else; 000242 08/26/26 + 243 *in60 = *off; 000243 08/26/26 + 244 endif; 000244 08/26/26 + 245 endsr; 000245 08/26/26 + 246 000246 08/26/26 + 247 // --------------------------------------------------------------------- 000247 08/26/26 + 248 begsr loadRows; 000248 08/26/26 + 249 numRows = 0; 000249 08/26/26 + 250 // PERP-84: display as MM/DD/YY. received_date/expiry_date are stored 000250 08/26/26 + 251 // as native DATE columns but rendered here as plain strings (SRECV/ 000251 08/26/26 + 252 // SEXPD carry no DATFMT keyword), so the format has to be built by 000252 08/26/26 + 253 // hand from the ISO string -- DB2 for i's CHAR(date,fmt) built-in 000253 08/26/26 + 254 // formats (ISO/USA/EUR/JIS) all use a 4-digit year, none produce a 000254 08/26/26 + 255 // 2-digit year directly. Same technique as wrkivpr.sqlrpgle (PERP-83). 000255 08/26/26 + 256 exec sql declare c1 cursor for 000256 08/26/26 + 257 select lot_number, qty_on_hand, 000257 08/26/26 + 258 substr(char(received_date, iso), 6, 2) || '/' 000258 08/26/26 + 259 || substr(char(received_date, iso), 9, 2) || '/' 000259 08/26/26 + 260 || substr(char(received_date, iso), 3, 2), 000260 08/26/26 + 261 case when expiry_date is null then '' 000261 08/26/26 + 262 else substr(char(expiry_date, iso), 6, 2) || '/' 000262 08/26/26 + 263 || substr(char(expiry_date, iso), 9, 2) || '/' 000263 08/26/26 + 264 || substr(char(expiry_date, iso), 3, 2) 000264 08/26/26 + 265 end 000265 08/26/26 + 266 from perpdemo.item_lot 000266 08/26/26 + 267 where company_code = :compcd and item_number = :filter 000267 08/26/26 + 268 order by lot_number; 000268 08/26/26 + 269 exec sql open c1; 000269 08/26/26 + 270 if sqlcode < 0; 000270 08/26/26 + 271 writeMsg('SQL open failed: SQLCODE=' + %char(sqlcode)); 000271 08/26/26 + 272 leavesr; 000272 08/26/26 + 273 endif; 000273 08/26/26 + 274 000274 08/26/26 + 275 dow numRows < %elem(rows); 000275 08/26/26 + 276 exec sql fetch c1 into :ltRow; 000276 08/26/26 + 277 if sqlcode = 100 or sqlcode < 0; 000277 08/26/26 + 278 leave; 000278 08/26/26 + 279 endif; 000279 08/26/26 + 280 numRows += 1; 000280 08/26/26 + 5770ST1 V7R5M0 220415 Create SQL ILE RPG Object WRKLOTR 08/26/26 16:51:50 Page 7 + Record *...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+... 9 ...+... 0 SEQNBR Last change + 281 rows(numRows) = ltRow; 000281 08/26/26 + 282 enddo; 000282 08/26/26 + 283 exec sql close c1; 000283 08/26/26 + 284 endsr; 000284 08/26/26 + 285 000285 08/26/26 + 286 // --------------------------------------------------------------------- 000286 08/26/26 + 287 begsr fillSubfile; 000287 08/26/26 + 288 rrn = 0; 000288 08/26/26 + 289 *in31 = *on; 000289 08/26/26 + 290 write ltctl; 000290 08/26/26 + 291 *in31 = *off; 000291 08/26/26 + 292 for i = 1 to numRows; 000292 08/26/26 + 293 *in50 = *off; 000293 08/26/26 + 294 *in51 = *off; 000294 08/26/26 + 295 sopt = ''; 000295 08/26/26 + 296 slot = rows(i).lot; 000296 08/26/26 + 297 sqty = rows(i).qty; 000297 08/26/26 + 298 srecv = rows(i).recv; 000298 08/26/26 + 299 sexpd = rows(i).expd; 000299 08/26/26 + 300 rrn += 1; 000300 08/26/26 + 301 write ltsfl; 000301 08/26/26 + 302 endfor; 000302 08/26/26 + 303 endsr; 000303 08/26/26 + 304 000304 08/26/26 + 305 // --------------------------------------------------------------------- 000305 08/26/26 + 306 begsr handleOpt; 000306 08/26/26 + 307 chain selRrn ltsfl; 000307 08/26/26 + 308 if %found(wrklotd); 000308 08/26/26 + 309 select; 000309 08/26/26 + 310 when selOpt = '2'; 000310 08/26/26 + 311 exsr changeRow; 000311 08/26/26 + 312 when selOpt = '4'; 000312 08/26/26 + 313 exsr deleteRow; 000313 08/26/26 + 314 other; 000314 08/26/26 + 315 writeMsg('Option ' + selOpt + ' not valid.'); 000315 08/26/26 + 316 holdMsg = *on; 000316 08/26/26 + 317 endsl; 000317 08/26/26 + 318 endif; 000318 08/26/26 + 319 endsr; 000319 08/26/26 + 320 000320 08/26/26 + 321 // --------------------------------------------------------------------- 000321 08/26/26 + 322 begsr addRow; 000322 08/26/26 + 323 exsr clearMsgs; 000323 08/26/26 + 324 emode = 'A'; 000324 08/26/26 + 325 elot = ''; 000325 08/26/26 + 326 eqty = 0; 000326 08/26/26 + 327 erecv = %char(%date():*mdy); 000327 08/26/26 + 328 eexpd = ''; 000328 08/26/26 + 329 eactive = 'Y'; 000329 08/26/26 + 330 exsr editLoop; 000330 08/26/26 + 331 if not *in12 and elot <> ''; 000331 08/26/26 + 332 exec sql 000332 08/26/26 + 333 insert into perpdemo.item_lot 000333 08/26/26 + 334 (company_code, item_number, lot_number, qty_on_hand, received_date, expiry_date) 000334 08/26/26 + 335 values (:compcd, :filter, :elot, :eqty, date(:erecv), 000335 08/26/26 + 336 case when :eexpd = '' then null else date(:eexpd) end); 000336 08/26/26 + 5770ST1 V7R5M0 220415 Create SQL ILE RPG Object WRKLOTR 08/26/26 16:51:50 Page 8 + Record *...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+... 9 ...+... 0 SEQNBR Last change + 337 if sqlcode < 0; 000337 08/26/26 + 338 writeMsg('Add failed: SQLCODE=' + %char(sqlcode) 000338 08/26/26 + 339 + ' SQLSTATE=' + sqlstate); 000339 08/26/26 + 340 else; 000340 08/26/26 + 341 writeMsg('Added lot ' + %trim(elot) + '.'); 000341 08/26/26 + 342 endif; 000342 08/26/26 + 343 holdMsg = *on; 000343 08/26/26 + 344 endif; 000344 08/26/26 + 345 endsr; 000345 08/26/26 + 346 000346 08/26/26 + 347 // --------------------------------------------------------------------- 000347 08/26/26 + 348 begsr changeRow; 000348 08/26/26 + 349 exsr clearMsgs; 000349 08/26/26 + 350 emode = 'C'; 000350 08/26/26 + 351 elot = slot; 000351 08/26/26 + 352 eqty = sqty; 000352 08/26/26 + 353 erecv = srecv; 000353 08/26/26 + 354 eexpd = sexpd; 000354 08/26/26 + 355 eactive = 'Y'; 000355 08/26/26 + 356 exsr editLoop; 000356 08/26/26 + 357 if not *in12; 000357 08/26/26 + 358 exec sql 000358 08/26/26 + 359 update perpdemo.item_lot 000359 08/26/26 + 360 set qty_on_hand = :eqty, 000360 08/26/26 + 361 received_date = date(:erecv), 000361 08/26/26 + 362 expiry_date = case when :eexpd = '' then null else date(:eexpd) end, 000362 08/26/26 + 363 updated_at = current_timestamp, 000363 08/26/26 + 364 updated_by = user 000364 08/26/26 + 365 where company_code = :compcd and item_number = :filter and lot_number = :elot; 000365 08/26/26 + 366 if sqlcode < 0; 000366 08/26/26 + 367 writeMsg('Change failed: SQLCODE=' + %char(sqlcode)); 000367 08/26/26 + 368 else; 000368 08/26/26 + 369 writeMsg('Updated lot ' + %trim(elot) + '.'); 000369 08/26/26 + 370 endif; 000370 08/26/26 + 371 holdMsg = *on; 000371 08/26/26 + 372 endif; 000372 08/26/26 + 373 endsr; 000373 08/26/26 + 374 000374 08/26/26 + 375 // --------------------------------------------------------------------- 000375 08/26/26 + 376 begsr deleteRow; 000376 08/26/26 + 377 exsr clearMsgs; 000377 08/26/26 + 378 exec sql 000378 08/26/26 + 379 delete from perpdemo.item_lot 000379 08/26/26 + 380 where company_code = :compcd and item_number = :filter and lot_number = :slot; 000380 08/26/26 + 381 if sqlcode < 0; 000381 08/26/26 + 382 writeMsg('Delete failed: SQLSTATE=' + sqlstate); 000382 08/26/26 + 383 else; 000383 08/26/26 + 384 writeMsg('Deleted lot ' + %trim(slot) + '.'); 000384 08/26/26 + 385 endif; 000385 08/26/26 + 386 holdMsg = *on; 000386 08/26/26 + 387 endsr; 000387 08/26/26 + 388 000388 08/26/26 + 389 // --------------------------------------------------------------------- 000389 08/26/26 + 390 // PERP-84: erecv/eexpd are typed by the user as MM/DD/YY on LTEDIT. 000390 08/26/26 + 391 // Validate on every Enter; on failure, show the error in the message 000391 08/26/26 + 392 // subfile alongside LTEDIT and let the user retry (never crash into 000392 08/26/26 + 5770ST1 V7R5M0 220415 Create SQL ILE RPG Object WRKLOTR 08/26/26 16:51:50 Page 9 + Record *...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+... 9 ...+... 0 SEQNBR Last change + 393 // the SQL date(:erecv) cast in addRow/changeRow with unparsed text). 000393 08/26/26 + 394 // On success, erecv/eexpd are normalized to ISO ('yyyy-mm-dd') text so 000394 08/26/26 + 395 // the existing date(:erecv)/date(:eexpd) SQL casts in addRow/changeRow 000395 08/26/26 + 396 // keep working unchanged. 000396 08/26/26 + 397 begsr editLoop; 000397 08/26/26 + 398 exsr clearMsgs; 000398 08/26/26 + 399 dow *on; 000399 08/26/26 + 400 if msgrrn > 0; 000400 08/26/26 + 401 *in40 = *on; 000401 08/26/26 + 402 write ltmsgctl; 000402 08/26/26 + 403 else; 000403 08/26/26 + 404 *in40 = *off; 000404 08/26/26 + 405 endif; 000405 08/26/26 + 406 exfmt ltedit; 000406 08/26/26 + 407 000407 08/26/26 + 408 if *in12; 000408 08/26/26 + 409 leave; 000409 08/26/26 + 410 endif; 000410 08/26/26 + 411 000411 08/26/26 + 412 exsr clearMsgs; 000412 08/26/26 + 413 000413 08/26/26 + 414 if %trim(elot) = ''; 000414 08/26/26 + 415 writeMsg('Lot Number is required.'); 000415 08/26/26 + 416 iter; 000416 08/26/26 + 417 endif; 000417 08/26/26 + 418 000418 08/26/26 + 419 if %trim(erecv) = ''; 000419 08/26/26 + 420 writeMsg('Received Date is required (MM/DD/YY).'); 000420 08/26/26 + 421 iter; 000421 08/26/26 + 422 endif; 000422 08/26/26 + 423 000423 08/26/26 + 424 validRecv = *on; 000424 08/26/26 + 425 monitor; 000425 08/26/26 + 426 parsedRecv = %date(%trim(erecv):*mdy); 000426 08/26/26 + 427 on-error; 000427 08/26/26 + 428 validRecv = *off; 000428 08/26/26 + 429 endmon; 000429 08/26/26 + 430 if not validRecv; 000430 08/26/26 + 431 writeMsg('Invalid Received Date - enter as MM/DD/YY.'); 000431 08/26/26 + 432 iter; 000432 08/26/26 + 433 endif; 000433 08/26/26 + 434 000434 08/26/26 + 435 validExpd = *on; 000435 08/26/26 + 436 if %trim(eexpd) <> ''; 000436 08/26/26 + 437 monitor; 000437 08/26/26 + 438 parsedExpd = %date(%trim(eexpd):*mdy); 000438 08/26/26 + 439 on-error; 000439 08/26/26 + 440 validExpd = *off; 000440 08/26/26 + 441 endmon; 000441 08/26/26 + 442 endif; 000442 08/26/26 + 443 if not validExpd; 000443 08/26/26 + 444 writeMsg('Invalid Expiry Date - enter as MM/DD/YY, or blank for none.'); 000444 08/26/26 + 445 iter; 000445 08/26/26 + 446 endif; 000446 08/26/26 + 447 000447 08/26/26 + 448 erecv = %char(parsedRecv:*iso); 000448 08/26/26 + 5770ST1 V7R5M0 220415 Create SQL ILE RPG Object WRKLOTR 08/26/26 16:51:50 Page 10 + Record *...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+... 9 ...+... 0 SEQNBR Last change + 449 if %trim(eexpd) <> ''; 000449 08/26/26 + 450 eexpd = %char(parsedExpd:*iso); 000450 08/26/26 + 451 endif; 000451 08/26/26 + 452 000452 08/26/26 + 453 leave; 000453 08/26/26 + 454 enddo; 000454 08/26/26 + 455 endsr; 000455 08/26/26 + 456 000456 08/26/26 + 457 // --------------------------------------------------------------------- 000457 08/26/26 + 458 begsr clearMsgs; 000458 08/26/26 + 459 msgrrn = 0; 000459 08/26/26 + 460 *in41 = *on; 000460 08/26/26 + 461 write ltmsgctl; 000461 08/26/26 + 462 *in41 = *off; 000462 08/26/26 + 463 endsr; 000463 08/26/26 + 464 000464 08/26/26 + 465 // --------------------------------------------------------------------- 000465 08/26/26 + 466 dcl-proc writeMsg; 000466 08/26/26 + 467 dcl-pi *n; 000467 08/26/26 + 468 text varchar(256) const; 000468 08/26/26 + 469 end-pi; 000469 08/26/26 + 470 dcl-s data char(256); 000470 08/26/26 + 471 data = text; 000471 08/26/26 + 472 QMHSNDPM( 000472 08/26/26 + 473 'CPF9897' : 000473 08/26/26 + 474 'QCPFMSG QSYS ' : 000474 08/26/26 + 475 data : 000475 08/26/26 + 476 %len(text) : 000476 08/26/26 + 477 '*INFO ' : 000477 08/26/26 + 478 '* ' : 000478 08/26/26 + 479 1 : 000479 08/26/26 + 480 smsgkey : 000480 08/26/26 + 481 x'0000000000000000'); 000481 08/26/26 + 482 msgrrn += 1; 000482 08/26/26 + 483 spgmq = statusDS.programName; 000483 08/26/26 + 484 write ltmsgsfl; 000484 08/26/26 + 485 end-proc; 000485 08/26/26 + * * * * * E N D O F S O U R C E * * * * * + 5770ST1 V7R5M0 220415 Create SQL ILE RPG Object WRKLOTR 08/26/26 16:51:50 Page 11 + CROSS REFERENCE + Data Names Define Reference + AISLE 229 VARCHAR(10) CCSID 37 COLUMN (NOT NULL) IN PERPDEMO.ITEM + AISLE_CODE 229 COLUMN FOR AISLE IN PERPDEMO.ITEM + BAY 229 VARCHAR(10) CCSID 37 COLUMN (NOT NULL) IN PERPDEMO.ITEM + BAY_CODE 229 COLUMN FOR BAY IN PERPDEMO.ITEM + CALLITMPRMT 48 + CLASS_CODE 229 COLUMN FOR CLSCD IN PERPDEMO.ITEM + CLSCD 229 VARCHAR(10) CCSID 37 COLUMN (NOT NULL) IN PERPDEMO.ITEM + COMPANY_CODE **** COLUMN + 230 237 267 334 365 380 + COMPANY_CODE 266 COLUMN FOR COMPCD IN PERPDEMO.ITEM_LOT + COMPANY_CODE 229 COLUMN FOR COMPCD IN PERPDEMO.ITEM + COMPCD 31 CHARACTER(3) IN LDADS + COMPCD 73 CHARACTER(3) + 230 237 267 335 365 380 + COMPCD 266 CHARACTER(3) CCSID 37 COLUMN (NOT NULL) IN PERPDEMO.ITEM_LOT + COMPCD 229 CHARACTER(3) CCSID 37 COLUMN (NOT NULL) IN PERPDEMO.ITEM + CREATED_AT 266 COLUMN FOR CRTAT IN PERPDEMO.ITEM_LOT + CREATED_AT 229 COLUMN FOR CRTAT IN PERPDEMO.ITEM + CREATED_BY 266 COLUMN FOR CRTBY IN PERPDEMO.ITEM_LOT + CREATED_BY 229 COLUMN FOR CRTBY IN PERPDEMO.ITEM + CRITICAL_LEVEL 229 COLUMN FOR CRITLV IN PERPDEMO.ITEM + CRITLV 229 DECIMAL(15,4) COLUMN (NOT NULL) IN PERPDEMO.ITEM + CRTAT 266 TIMESTAMP(26) COLUMN (NOT NULL) IN PERPDEMO.ITEM_LOT + CRTAT 229 TIMESTAMP(26) COLUMN (NOT NULL) IN PERPDEMO.ITEM + CRTBY 266 VARCHAR(18) CCSID 37 COLUMN (NOT NULL) IN PERPDEMO.ITEM_LOT + CRTBY 229 VARCHAR(18) CCSID 37 COLUMN (NOT NULL) IN PERPDEMO.ITEM + C1 256 CURSOR + 269 276 283 + DATA 470 CHARACTER(256) IN RPG PROCEDURE WRITEMSG + EACTIVE 28 CHARACTER(1) + EEXPD 28 CHARACTER(10) + 5770ST1 V7R5M0 220415 Create SQL ILE RPG Object WRKLOTR 08/26/26 16:51:50 Page 12 + CROSS REFERENCE + 336 336 362 362 + ELOT 28 CHARACTER(20) + 335 365 + EMODE 28 CHARACTER(1) + EQTY 28 DECIMAL(15,4) + 335 360 + ERECV 28 CHARACTER(10) + 335 361 + EXPD 61 VARCHAR(10) IN LTROW + EXPD 64 VARCHAR(10) IN ROWS + EXPDT 266 DATE(10) COLUMN IN PERPDEMO.ITEM_LOT + EXPIRY_DATE **** COLUMN + 261 262 263 264 334 362 + EXPIRY_DATE 266 COLUMN FOR EXPDT IN PERPDEMO.ITEM_LOT + FILTER 72 VARCHAR(25) + 230 237 267 335 365 380 + HOLDMSG 77 CHARACTER(1) + I 66 INTEGER PRECISION(9,0) + INVENTORY_UOM 229 COLUMN FOR INVUOM IN PERPDEMO.ITEM + INVUOM 229 VARCHAR(5) CCSID 37 COLUMN (NOT NULL) IN PERPDEMO.ITEM + IS_ACTIVE 266 COLUMN FOR ISACT IN PERPDEMO.ITEM_LOT + IS_ACTIVE 229 COLUMN FOR ISACT IN PERPDEMO.ITEM + ISACT 266 CHARACTER(1) CCSID 37 COLUMN (NOT NULL) IN PERPDEMO.ITEM_LOT + ISACT 229 CHARACTER(1) CCSID 37 COLUMN (NOT NULL) IN PERPDEMO.ITEM + ISO **** COLUMN + 258 259 260 262 263 264 + ITEM **** TABLE IN PERPDEMO + 229 + ITEM_DESCRIPTION 229 COLUMN FOR ITMDSC IN PERPDEMO.ITEM + ITEM_LOT **** TABLE IN PERPDEMO + 236 266 333 359 379 + ITEM_NUMBER **** COLUMN + 230 237 267 334 365 380 + ITEM_NUMBER 266 COLUMN FOR ITMNBR IN PERPDEMO.ITEM_LOT + ITEM_NUMBER 229 COLUMN FOR ITMNBR IN PERPDEMO.ITEM + ITEMOH 74 DECIMAL(15,4) + 228 + ITMDSC 229 VARCHAR(60) CCSID 37 COLUMN (NOT NULL) IN PERPDEMO.ITEM + ITMNBR 266 VARCHAR(25) CCSID 37 COLUMN (NOT NULL) IN PERPDEMO.ITEM_LOT + 5770ST1 V7R5M0 220415 Create SQL ILE RPG Object WRKLOTR 08/26/26 16:51:50 Page 13 + CROSS REFERENCE + ITMNBR 229 VARCHAR(25) CCSID 37 COLUMN (NOT NULL) IN PERPDEMO.ITEM + LDADS 30 STRUCTURE + LEAD_TIME_DAYS 229 COLUMN FOR LEADTM IN PERPDEMO.ITEM + LEADTM 229 INTEGER PRECISION(9,0) COLUMN (NOT NULL) IN PERPDEMO.ITEM + LOT 58 VARCHAR(20) IN LTROW + LOT 64 VARCHAR(20) IN ROWS + LOT_CONTROLLED 229 COLUMN FOR LOTCTL IN PERPDEMO.ITEM + LOT_NUMBER **** COLUMN + 257 268 334 365 380 + LOT_NUMBER 266 COLUMN FOR LOTNBR IN PERPDEMO.ITEM_LOT + LOTCTL 229 CHARACTER(1) CCSID 37 COLUMN (NOT NULL) IN PERPDEMO.ITEM + LOTNBR 266 VARCHAR(20) CCSID 37 COLUMN (NOT NULL) IN PERPDEMO.ITEM_LOT + LOTTOTAL 75 DECIMAL(15,4) + 235 + LTROW 57 STRUCTURE + 276 + MAX_QTY 229 COLUMN FOR MAXQTY IN PERPDEMO.ITEM + MAXQTY 229 DECIMAL(15,4) COLUMN (NOT NULL) IN PERPDEMO.ITEM + MIN_QTY 229 COLUMN FOR MINQTY IN PERPDEMO.ITEM + MINQTY 229 DECIMAL(15,4) COLUMN (NOT NULL) IN PERPDEMO.ITEM + MSGKEY 69 CHARACTER(4) + MSGRRN 68 INTEGER PRECISION(9,0) + NUMROWS 65 INTEGER PRECISION(9,0) + PARSEDEXPD 86 DATE(8) + PARSEDRECV 85 DATE(8) + PCOMPCD 24 CHARACTER(3) CONSTANT + PERPDEMO **** SCHEMA + 229 236 266 333 359 379 + PITEM 25 VARCHAR(25) CONSTANT + PROGRAMNAME 54 CHARACTER(10) IN STATUSDS + PROMPTITEM 76 VARCHAR(25) + QMHSNDPM 34 + 5770ST1 V7R5M0 220415 Create SQL ILE RPG Object WRKLOTR 08/26/26 16:51:50 Page 14 + CROSS REFERENCE + QTY 59 DECIMAL(15,4) IN LTROW + QTY 64 DECIMAL(15,4) IN ROWS + QTY_AVAILABLE 229 COLUMN FOR QTYAVL IN PERPDEMO.ITEM + QTY_FROZEN 229 COLUMN FOR QTYFRZ IN PERPDEMO.ITEM + QTY_ON_HAND **** COLUMN + 228 235 257 334 360 + QTY_ON_HAND 266 COLUMN FOR QTYOH IN PERPDEMO.ITEM_LOT + QTY_ON_HAND 229 COLUMN FOR QTYOH IN PERPDEMO.ITEM + QTY_ON_ORDER 229 COLUMN FOR QTYOO IN PERPDEMO.ITEM + QTYAVL 229 DECIMAL(15,4) COLUMN (NOT NULL) IN PERPDEMO.ITEM + QTYFRZ 229 DECIMAL(15,4) COLUMN (NOT NULL) IN PERPDEMO.ITEM + QTYOH 266 DECIMAL(15,4) COLUMN (NOT NULL) IN PERPDEMO.ITEM_LOT + QTYOH 229 DECIMAL(15,4) COLUMN (NOT NULL) IN PERPDEMO.ITEM + QTYOO 229 DECIMAL(15,4) COLUMN (NOT NULL) IN PERPDEMO.ITEM + RCVDT 266 DATE(10) COLUMN (NOT NULL) IN PERPDEMO.ITEM_LOT + RECEIVED_DATE **** COLUMN + 258 259 260 334 361 + RECEIVED_DATE 266 COLUMN FOR RCVDT IN PERPDEMO.ITEM_LOT + RECV 60 VARCHAR(10) IN LTROW + RECV 64 VARCHAR(10) IN ROWS + REORDER_POINT 229 COLUMN FOR RORDPT IN PERPDEMO.ITEM + RORDPT 229 DECIMAL(15,4) COLUMN (NOT NULL) IN PERPDEMO.ITEM + ROWS 64 ARRAY(500) STRUCTURE + RRN 67 INTEGER PRECISION(9,0) + SAFETY_STOCK 229 COLUMN FOR SAFSTK IN PERPDEMO.ITEM + SAFSTK 229 DECIMAL(15,4) COLUMN (NOT NULL) IN PERPDEMO.ITEM + SCOMPDSP 28 CHARACTER(3) + SELOPT 71 CHARACTER(1) + SELRRN 70 INTEGER PRECISION(9,0) + SEXPD 28 CHARACTER(10) + 5770ST1 V7R5M0 220415 Create SQL ILE RPG Object WRKLOTR 08/26/26 16:51:50 Page 15 + CROSS REFERENCE + SFITEM 28 CHARACTER(25) + SHELF 229 VARCHAR(10) CCSID 37 COLUMN (NOT NULL) IN PERPDEMO.ITEM + SHELF_CODE 229 COLUMN FOR SHELF IN PERPDEMO.ITEM + SHORT_DESCRIPTION 229 COLUMN FOR SHTDSC IN PERPDEMO.ITEM + SHTDSC 229 VARCHAR(20) CCSID 37 COLUMN (NOT NULL) IN PERPDEMO.ITEM + SIOH 28 DECIMAL(15,4) + SLOT 28 CHARACTER(20) + 380 + SLOTTOT 28 DECIMAL(15,4) + SMSGKEY 28 CHARACTER(4) + SOPT 28 CHARACTER(1) + SPGMQ 28 CHARACTER(10) + SQTY 28 DECIMAL(15,4) + SRECV 28 CHARACTER(10) + STATUSDS 53 STRUCTURE + STKUOM 229 VARCHAR(5) CCSID 37 COLUMN (NOT NULL) IN PERPDEMO.ITEM + STOCKING_UOM 229 COLUMN FOR STKUOM IN PERPDEMO.ITEM + TEXT 468 VARCHAR(256) CONSTANT IN RPG PROCEDURE WRITEMSG + UPDAT 266 TIMESTAMP(26) COLUMN (NOT NULL) IN PERPDEMO.ITEM_LOT + UPDAT 229 TIMESTAMP(26) COLUMN (NOT NULL) IN PERPDEMO.ITEM + UPDATED_AT 266 COLUMN FOR UPDAT IN PERPDEMO.ITEM_LOT + UPDATED_AT 229 COLUMN FOR UPDAT IN PERPDEMO.ITEM + UPDATED_AT **** COLUMN + 363 + UPDATED_BY 266 COLUMN FOR UPDBY IN PERPDEMO.ITEM_LOT + UPDATED_BY 229 COLUMN FOR UPDBY IN PERPDEMO.ITEM + UPDATED_BY **** COLUMN + 364 + UPDBY 266 VARCHAR(18) CCSID 37 COLUMN (NOT NULL) IN PERPDEMO.ITEM_LOT + UPDBY 229 VARCHAR(18) CCSID 37 COLUMN (NOT NULL) IN PERPDEMO.ITEM + VALIDEXPD 88 CHARACTER(1) + 5770ST1 V7R5M0 220415 Create SQL ILE RPG Object WRKLOTR 08/26/26 16:51:50 Page 16 + CROSS REFERENCE + VALIDRECV 87 CHARACTER(1) + WRITEMSG 466 RPG PROCEDURE + No errors found in source + 485 Source records processed + * * * * * E N D O F L I S T I N G * * * * * + 5770WDS V7R5M0 220415 RN IBM ILE RPG PERPDEMO/WRKLOTR IDEV 08/26/26 16:51:50 Page 1 + Command . . . . . . . . . . . . : CRTBNDRPG + Issued by . . . . . . . . . . : AIDEMO + Program . . . . . . . . . . . . : WRKLOTR + Library . . . . . . . . . . . : PERPDEMO + Text 'description' . . . . . . . : *SRCMBRTXT + Source stream file . . . . . . : /QSYS.LIB/QTEMP.LIB/QSQLTEMP1.FILE/WRKLOTR.MBR + CCSID . . . . . . . . . . . . : 37 + Target CCSID . . . . . . . . . . : *JOB (37) + Text 'description' . . . . . . . : + Last Change . . . . . . . . . . : 08/26/26 16:51:50 + Generation severity level . . . : 10 + Default activation group . . . . : *YES + Compiler options . . . . . . . . : *XREF *GEN *NOSECLVL *SHOWCPY + *EXPDDS *EXT *NOSHOWSKP *NOSRCSTMT + *DEBUGIO *UNREF *NOEVENTF + Debugging views . . . . . . . . : *ALL + Debug encryption key . . . . . . : *NONE + Output . . . . . . . . . . . . . : *PRINT + Optimization level . . . . . . . : *NONE + Source listing indentation . . . : *NONE + Type conversion options . . . . : *NONE + Sort sequence . . . . . . . . . : *JOB + Language identifier . . . . . . : *JOB + Replace program . . . . . . . . : *YES + User profile . . . . . . . . . . : *USER + Authority . . . . . . . . . . . : *LIBCRTAUT + Truncate numeric . . . . . . . . : *YES + Fix numeric . . . . . . . . . . : *NONE + Target release . . . . . . . . . : V7R4M0 + Allow null values . . . . . . . : *NO + Define condition names . . . . . : *NONE + Enable performance collection . : *PEP + Profiling data . . . . . . . . . : *NOCOL + Licensed Internal Code options . : + Generate program interface . . . : *NO + Include directory . . . . . . . : . + Preprocessor options . . . . . . : *NONE + Require prototype for export . . : *NO + 5770WDS V7R5M0 220415 RN IBM ILE RPG PERPDEMO/WRKLOTR IDEV 08/26/26 16:51:50 Page 2 + Line <---------------------- Source Specifications -----------------------------------------------------> Do Change Src Seq + Number ....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8....+....9....+...10 Num Date Id Number + S o u r c e L i s t i n g + 1 **free 000001 + 2 000002 + 3 // --------------------------------------------------------------------- 000003 + 4 // Program: wrklotr (Work with Item Lots) 000004 + 5 // Purpose: DSPF-based CRUD for item_lot, scoped by the company selected 000005 + 6 // via perpselr (*LDA positions 1-3) and an item number entered 000006 + 7 // on screen (same scoping idiom as wrkcnvr). Shows item.on_hand 000007 + 8 // alongside SUM(item_lot.qty_on_hand) and flags a discrepancy 000008 + 9 // -- the entry point for the reconciliation demo (Option C: 000009 + 10 // balances denormalized on both item and item_lot by design). 000010 + 11 // Callable standalone or pre-scoped by passing company/item 000011 + 12 // (mirrors wrkcnvr's PERP-23 integration). 000012 + 13 // Epic: PERP-3 (PERP-24) 000013 + 14 // --------------------------------------------------------------------- 000014 + 15 000015 + 16 // PERP-84: datfmt(*iso) is required now that this program declares 000016 + 17 // Date-typed variables (parsedRecv/parsedExpd below) to validate the 000017 + 18 // MM/DD/YY Received/Expiry Date entry fields. Without this override the 000018 + 19 // job's *MDY (1940-2039) DATFMT becomes the Date variables' storage 000019 + 20 // format, per perp/AGENTS.md's RNQ0114 gotcha. 000020 + 21 ctl-opt dftactgrp(*no) actgrp(*new) datfmt(*iso); 000021 + 22 000022 + *--------------------------------------------------------------------* + * Compiler Options in Effect: * + *--------------------------------------------------------------------* + * Text 'description' . . . . . . . : * + * Generation severity level . . . : 10 * + * Default activation group . . . . : *NO * + * Compiler options . . . . . . . . : *XREF *GEN * + * *NOSECLVL *SHOWCPY * + * *EXPDDS *EXT * + * *NOSHOWSKP *NOSRCSTMT * + * *DEBUGIO *UNREF * + * *NOEVENTF * + * Optimization level . . . . . . . : *NONE * + * Source listing indentation . . . : *NONE * + * Type conversion options . . . . : *NONE * + * Sort sequence . . . . . . . . . : *JOB * + * Language identifier . . . . . . : *JOB * + * User profile . . . . . . . . . . : *USER * + * Authority . . . . . . . . . . . : *LIBCRTAUT * + * Truncate numeric . . . . . . . . : *YES * + * Fix numeric . . . . . . . . . . : *NONE * + * Allow null values . . . . . . . : *NO * + * Storage model . . . . . . . . . : *SNGLVL * + * Binding directory from Command . : *NONE * + * Binding directory from Source . : *NONE * + * Activation group . . . . . . . . : *NEW * + * Enable performance collection . : *PEP * + * Profiling data . . . . . . . . . : *NOCOL * + * Generate program interface . . . : *NO * + * REQUIRE PROTOTYPE FOR EXPORT . . : *NO * + 5770WDS V7R5M0 220415 RN IBM ILE RPG PERPDEMO/WRKLOTR IDEV 08/26/26 16:51:50 Page 3 + Line <---------------------- Source Specifications -----------------------------------------------------> Do Change Src Seq + Number ....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8....+....9....+...10 Num Date Id Number + *--------------------------------------------------------------------* + 23 dcl-pi *n; 000023 + 24 pCompcd char(3) const options(*nopass); 000024 + 25 pItem varchar(25) const options(*nopass); 000025 + 26 end-pi; 000026 + 27 000027 + 28 dcl-f wrklotd workstn sfile(ltsfl:rrn) sfile(ltmsgsfl:msgrrn); 000028 + *--------------------------------------------------------------------------------------------* + * RPG name External name * + * File name. . . . . . . . . : WRKLOTD PERPDEMO/WRKLOTD * + * Record format(s) . . . . . : LTSFL LTSFL * + * LTCTL LTCTL * + * LTFOOT LTFOOT * + * LTNONE LTNONE * + * LTNOITEM LTNOITEM * + * LTEDIT LTEDIT * + * LTMSGSFL LTMSGSFL * + * LTMSGCTL LTMSGCTL * + *--------------------------------------------------------------------------------------------* + 29 000029 + 30 dcl-ds ldaDS dtaara(*lda) len(1024) qualified; 000030 + 31 compcd char(3) pos(1); 000031 + 32 end-ds; 000032 + 33 000033 + 34 dcl-pr QMHSNDPM extpgm; 000034 + 35 msgId char(7) const; 000035 + 36 msgF char(20) const; 000036 + 37 msgData char(256) const; 000037 + 38 msgDataLen int(10) const; 000038 + 39 msgType char(10) const; 000039 + 40 stackEntry char(10) const; 000040 + 41 stackCntr int(10) const; 000041 + 42 msgKey char(4); 000042 + 43 errorCode char(8) const; 000043 + 44 end-pr; 000044 + 45 000045 + 46 // Standard, reusable Item Number prompt (PERP-51/PERP-56). Same dynamic 000046 + 47 // CALL idiom as wrkitmr's callWrkcnvr/callWrklotr. 000047 + 48 dcl-pr callItmprmt extpgm('ITMPRMT'); 000048 + 49 pCompcd char(3) const; 000049 + 50 pItem varchar(25); 000050 + 51 end-pr; 000051 + 52 000052 + 53 dcl-ds statusDS psds qualified; 000053 + 54 programName char(10) pos(334); 000054 + 55 end-ds; 000055 + 56 000056 + 57 dcl-ds ltRow qualified; 000057 + 58 lot varchar(20); 000058 + 59 qty packed(15:4); 000059 + 5770WDS V7R5M0 220415 RN IBM ILE RPG PERPDEMO/WRKLOTR IDEV 08/26/26 16:51:50 Page 4 + Line <---------------------- Source Specifications -----------------------------------------------------> Do Change Src Seq + Number ....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8....+....9....+...10 Num Date Id Number + 60 recv varchar(10); 000060 + 61 expd varchar(10); 000061 + 62 end-ds; 000062 + 63 000063 + 64 dcl-ds rows likeds(ltRow) dim(500); 000064 + 65 dcl-s numRows int(10); 000065 + 66 dcl-s i int(10); 000066 + 67 dcl-s rrn int(10); 000067 + 68 dcl-s msgrrn int(10); 000068 + 69 dcl-s msgkey char(4); 000069 + 70 dcl-s selRrn int(10); 000070 + 71 dcl-s selOpt char(1); 000071 + 72 dcl-s filter varchar(25); 000072 + 73 dcl-s compcd char(3); 000073 + 74 dcl-s itemOh packed(15:4); 000074 + 75 dcl-s lotTotal packed(15:4); 000075 + 76 dcl-s promptItem varchar(25); 000076 + 77 dcl-s holdMsg ind; 000077 + 78 000078 + 79 // PERP-84: MM/DD/YY entry validation for ERECV/EEXPD (see editLoop). 000079 + 80 // parsedRecv/parsedExpd are Date-typed working vars used only to 000080 + 81 // validate/reformat the typed text -- they are never bound directly to 000081 + 82 // an SQL host variable (erecv/eexpd stay char(10) for that), so the 000082 + 83 // SQL-precompiler-intermediate-host-variable *MDY cap documented in 000083 + 84 // perp/AGENTS.md #13 does not come into play here. 000084 + 85 dcl-s parsedRecv date; 000085 + 86 dcl-s parsedExpd date; 000086 + 87 dcl-s validRecv ind; 000087 + 88 dcl-s validExpd ind; 000088 + 89 000089 + 90 /SET CCSID(*CHAR:*JOBRUNMIX) 000090 + 91 // SQL COMMUNICATION AREA //SQL 000091 + 92 DCL-DS SQLCA; //SQL 000092 + 93 SQLCAID CHAR(8) INZ(X'0000000000000000'); //SQL 000093 + 94 SQLAID CHAR(8) OVERLAY(SQLCAID); //SQL 000094 + 95 SQLCABC INT(10); //SQL 000095 + 96 SQLABC BINDEC(9) OVERLAY(SQLCABC); //SQL 000096 + 97 SQLCODE INT(10); //SQL 000097 + 98 SQLCOD BINDEC(9) OVERLAY(SQLCODE); //SQL 000098 + 99 SQLERRML INT(5); //SQL 000099 + 100 SQLERL BINDEC(4) OVERLAY(SQLERRML); //SQL 000100 + 101 SQLERRMC CHAR(70); //SQL 000101 + 102 SQLERM CHAR(70) OVERLAY(SQLERRMC); //SQL 000102 + 103 SQLERRP CHAR(8); //SQL 000103 + 104 SQLERP CHAR(8) OVERLAY(SQLERRP); //SQL 000104 + 105 SQLERR CHAR(24); //SQL 000105 + 106 SQLER1 BINDEC(9) OVERLAY(SQLERR:*NEXT); //SQL 000106 + 107 SQLER2 BINDEC(9) OVERLAY(SQLERR:*NEXT); //SQL 000107 + 108 SQLER3 BINDEC(9) OVERLAY(SQLERR:*NEXT); //SQL 000108 + 109 SQLER4 BINDEC(9) OVERLAY(SQLERR:*NEXT); //SQL 000109 + 110 SQLER5 BINDEC(9) OVERLAY(SQLERR:*NEXT); //SQL 000110 + 111 SQLER6 BINDEC(9) OVERLAY(SQLERR:*NEXT); //SQL 000111 + 112 SQLERRD INT(10) DIM(6) OVERLAY(SQLERR); //SQL 000112 + 113 SQLWRN CHAR(11); //SQL 000113 + 114 SQLWN0 CHAR(1) OVERLAY(SQLWRN:*NEXT); //SQL 000114 + 115 SQLWN1 CHAR(1) OVERLAY(SQLWRN:*NEXT); //SQL 000115 + 5770WDS V7R5M0 220415 RN IBM ILE RPG PERPDEMO/WRKLOTR IDEV 08/26/26 16:51:50 Page 5 + Line <---------------------- Source Specifications -----------------------------------------------------> Do Change Src Seq + Number ....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8....+....9....+...10 Num Date Id Number + 116 SQLWN2 CHAR(1) OVERLAY(SQLWRN:*NEXT); //SQL 000116 + 117 SQLWN3 CHAR(1) OVERLAY(SQLWRN:*NEXT); //SQL 000117 + 118 SQLWN4 CHAR(1) OVERLAY(SQLWRN:*NEXT); //SQL 000118 + 119 SQLWN5 CHAR(1) OVERLAY(SQLWRN:*NEXT); //SQL 000119 + 120 SQLWN6 CHAR(1) OVERLAY(SQLWRN:*NEXT); //SQL 000120 + 121 SQLWN7 CHAR(1) OVERLAY(SQLWRN:*NEXT); //SQL 000121 + 122 SQLWN8 CHAR(1) OVERLAY(SQLWRN:*NEXT); //SQL 000122 + 123 SQLWN9 CHAR(1) OVERLAY(SQLWRN:*NEXT); //SQL 000123 + 124 SQLWNA CHAR(1) OVERLAY(SQLWRN:*NEXT); //SQL 000124 + 125 SQLWARN CHAR(1) DIM(11) OVERLAY(SQLWRN); //SQL 000125 + 126 SQLSTATE CHAR(5); //SQL 000126 + 127 SQLSTT CHAR(5) OVERLAY(SQLSTATE); //SQL 000127 + 128 END-DS SQLCA; //SQL 000128 + 129 DCL-PR SQLROUTE_CALL EXTPGM(SQLROUTE); //SQL 000129 + 130 CA LIKEDS(SQLCA); //SQL 000130 + 131 *N BINDEC(4) OPTIONS(*NOPASS); //SQL 000131 + 132 *N CHAR(1) OPTIONS(*NOPASS); //SQL 000132 + 133 END-PR SQLROUTE_CALL; //SQL 000133 + 134 DCL-PR SQLOPEN_CALL EXTPGM(SQLOPEN); //SQL 000134 + 135 CA LIKEDS(SQLCA); //SQL 000135 + 136 *N BINDEC(4); //SQL 000136 + 137 END-PR SQLOPEN_CALL; //SQL 000137 + 138 DCL-PR SQLCLSE_CALL EXTPGM(SQLCLSE); //SQL 000138 + 139 CA LIKEDS(SQLCA); //SQL 000139 + 140 *N BINDEC(4); //SQL 000140 + 141 END-PR SQLCLSE_CALL; //SQL 000141 + 142 DCL-PR SQLCMIT_CALL EXTPGM(SQLCMIT); //SQL 000142 + 143 CA LIKEDS(SQLCA); //SQL 000143 + 144 *N BINDEC(4); //SQL 000144 + 145 END-PR SQLCMIT_CALL; //SQL 000145 + 146 /RESTORE CCSID(*CHAR) 000146 + 147 DCL-C SQLROUTE CONST('QSYS/QSQROUTE'); //SQL 000147 + 148 DCL-C SQLOPEN CONST('QSYS/QSQROUTE'); //SQL 000148 + 149 DCL-C SQLCLSE CONST('QSYS/QSQLCLSE'); //SQL 000149 + 150 DCL-C SQLCMIT CONST('QSYS/QSQLCMIT'); //SQL 000150 + 151 DCL-C SQFRD CONST(2); //SQL 000151 + 152 DCL-C SQFCRT CONST(8); //SQL 000152 + 153 DCL-C SQFOVR CONST(16); //SQL 000153 + 154 DCL-C SQFAPP CONST(32); //SQL 000154 + 155 **END-FREE 000155 + Line <---------------------- Source Specifications ----------------------------><---- Comments ----> Do Page Change Src Seq + Number ....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8....+....9....+...10 Num Line Date Id Number + 156 D DS SELECT 000156 + 157 D SQL_00000 1 2B 0 INZ(128) length of header 000157 + 158 D SQL_00001 3 4B 0 INZ(2) statement number 000158 + 159 D SQL_00002 5 8U 0 INZ(0) invocation mark 000159 + 160 D SQL_00003 9 9A INZ('0') CCSID(*JOBRUNMIX) data is okay 000160 + 161 D SQL_00004 10 128A CCSID(*JOBRUNMIX) end of header 000161 + 162 D SQL_00005 129 131A CCSID(*JOBRUNMIX) COMPCD 000162 + 163 D SQL_00006 132 158A VARYING CCSID(*JOBRUNMIX) FILTER 000163 + 164 D SQL_00007 159 166P 4 ITEMOH 000164 + 5770WDS V7R5M0 220415 RN IBM ILE RPG PERPDEMO/WRKLOTR IDEV 08/26/26 16:51:50 Page 6 + Line <---------------------- Source Specifications -----------------------------------------------------> Do Change Src Seq + Number ....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8....+....9....+...10 Num Date Id Number + 165 **FREE 000165 + 166 **END-FREE 000166 + Line <---------------------- Source Specifications ----------------------------><---- Comments ----> Do Page Change Src Seq + Number ....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8....+....9....+...10 Num Line Date Id Number + 167 D DS SELECT 000167 + 168 D SQL_00008 1 2B 0 INZ(128) length of header 000168 + 169 D SQL_00009 3 4B 0 INZ(3) statement number 000169 + 170 D SQL_00010 5 8U 0 INZ(0) invocation mark 000170 + 171 D SQL_00011 9 9A INZ('0') CCSID(*JOBRUNMIX) data is okay 000171 + 172 D SQL_00012 10 128A CCSID(*JOBRUNMIX) end of header 000172 + 173 D SQL_00013 129 131A CCSID(*JOBRUNMIX) COMPCD 000173 + 174 D SQL_00014 132 158A VARYING CCSID(*JOBRUNMIX) FILTER 000174 + 175 D SQL_00015 159 166P 4 LOTTOTAL 000175 + Line <---------------------- Source Specifications -----------------------------------------------------> Do Change Src Seq + Number ....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8....+....9....+...10 Num Date Id Number + 176 **FREE 000176 + 177 **END-FREE 000177 + Line <---------------------- Source Specifications ----------------------------><---- Comments ----> Do Page Change Src Seq + Number ....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8....+....9....+...10 Num Line Date Id Number + 178 D DS OPEN 000178 + 179 D SQL_00016 1 2B 0 INZ(128) length of header 000179 + 180 D SQL_00017 3 4B 0 INZ(4) statement number 000180 + 181 D SQL_00018 5 8U 0 INZ(0) invocation mark 000181 + 182 D SQL_00019 9 9A INZ('0') CCSID(*JOBRUNMIX) data is okay 000182 + 183 D SQL_00020 10 128A CCSID(*JOBRUNMIX) end of header 000183 + 184 D SQL_00021 129 131A CCSID(*JOBRUNMIX) COMPCD 000184 + 185 D SQL_00022 132 158A VARYING CCSID(*JOBRUNMIX) FILTER 000185 + Line <---------------------- Source Specifications -----------------------------------------------------> Do Change Src Seq + Number ....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8....+....9....+...10 Num Date Id Number + 186 **FREE 000186 + 187 **END-FREE 000187 + Line <---------------------- Source Specifications ----------------------------><---- Comments ----> Do Page Change Src Seq + Number ....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8....+....9....+...10 Num Line Date Id Number + 188 D DS FETCH 000188 + 189 D SQL_00023 1 2B 0 INZ(128) length of header 000189 + 190 D SQL_00024 3 4B 0 INZ(5) statement number 000190 + 191 D SQL_00025 5 8U 0 INZ(0) invocation mark 000191 + 192 D SQL_00026 9 9A INZ('0') CCSID(*JOBRUNMIX) data is okay 000192 + 193 D SQL_00027 10 128A CCSID(*JOBRUNMIX) end of header 000193 + 194 D SQL_00028 129 150A VARYING CCSID(*JOBRUNMIX) LTROW.LOT 000194 + 195 D SQL_00029 151 158P 4 LTROW.QTY 000195 + 196 D SQL_00030 159 170A VARYING CCSID(*JOBRUNMIX) LTROW.RECV 000196 + 197 D SQL_00031 171 182A VARYING CCSID(*JOBRUNMIX) LTROW.EXPD 000197 + 5770WDS V7R5M0 220415 RN IBM ILE RPG PERPDEMO/WRKLOTR IDEV 08/26/26 16:51:50 Page 7 + Line <---------------------- Source Specifications -----------------------------------------------------> Do Change Src Seq + Number ....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8....+....9....+...10 Num Date Id Number + 198 **FREE 000198 + 199 **END-FREE 000199 + Line <---------------------- Source Specifications ----------------------------><---- Comments ----> Do Page Change Src Seq + Number ....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8....+....9....+...10 Num Line Date Id Number + 200 D DS CLOSE 000200 + 201 D SQL_00032 1 2B 0 INZ(128) length of header 000201 + 202 D SQL_00033 3 4B 0 INZ(6) statement number 000202 + 203 D SQL_00034 5 8U 0 INZ(0) invocation mark 000203 + 204 D SQL_00035 9 9A INZ('0') CCSID(*JOBRUNMIX) data is okay 000204 + 205 D SQL_00036 10 127A CCSID(*JOBRUNMIX) end of header 000205 + 206 D SQL_00037 128 128A CCSID(*JOBRUNMIX) end of header 000206 + Line <---------------------- Source Specifications -----------------------------------------------------> Do Change Src Seq + Number ....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8....+....9....+...10 Num Date Id Number + 207 **FREE 000207 + 208 **END-FREE 000208 + Line <---------------------- Source Specifications ----------------------------><---- Comments ----> Do Page Change Src Seq + Number ....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8....+....9....+...10 Num Line Date Id Number + 209 D DS INSERT 000209 + 210 D SQL_00038 1 2B 0 INZ(128) length of header 000210 + 211 D SQL_00039 3 4B 0 INZ(7) statement number 000211 + 212 D SQL_00040 5 8U 0 INZ(0) invocation mark 000212 + 213 D SQL_00041 9 9A INZ('0') CCSID(*JOBRUNMIX) data is okay 000213 + 214 D SQL_00042 10 127A CCSID(*JOBRUNMIX) end of header 000214 + 215 D SQL_00043 129 131A CCSID(*JOBRUNMIX) COMPCD 000215 + 216 D SQL_00044 132 158A VARYING CCSID(*JOBRUNMIX) FILTER 000216 + 217 D SQL_00045 159 178A CCSID(*JOBRUNMIX) ELOT 000217 + 218 D SQL_00046 179 186P 4 EQTY 000218 + 219 D SQL_00047 187 196A CCSID(*JOBRUNMIX) ERECV 000219 + 220 D SQL_00048 197 206A CCSID(*JOBRUNMIX) EEXPD 000220 + 221 D SQL_00049 207 216A CCSID(*JOBRUNMIX) EEXPD 000221 + Line <---------------------- Source Specifications -----------------------------------------------------> Do Change Src Seq + Number ....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8....+....9....+...10 Num Date Id Number + 222 **FREE 000222 + 223 **END-FREE 000223 + Line <---------------------- Source Specifications ----------------------------><---- Comments ----> Do Page Change Src Seq + Number ....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8....+....9....+...10 Num Line Date Id Number + 224 D DS UPDATE 000224 + 225 D SQL_00050 1 2B 0 INZ(128) length of header 000225 + 226 D SQL_00051 3 4B 0 INZ(8) statement number 000226 + 227 D SQL_00052 5 8U 0 INZ(0) invocation mark 000227 + 228 D SQL_00053 9 9A INZ('0') CCSID(*JOBRUNMIX) data is okay 000228 + 229 D SQL_00054 10 127A CCSID(*JOBRUNMIX) end of header 000229 + 230 D SQL_00055 129 136P 4 EQTY 000230 + 231 D SQL_00056 137 146A CCSID(*JOBRUNMIX) ERECV 000231 + 232 D SQL_00057 147 156A CCSID(*JOBRUNMIX) EEXPD 000232 + 233 D SQL_00058 157 166A CCSID(*JOBRUNMIX) EEXPD 000233 + 5770WDS V7R5M0 220415 RN IBM ILE RPG PERPDEMO/WRKLOTR IDEV 08/26/26 16:51:50 Page 8 + Line <---------------------- Source Specifications ----------------------------><---- Comments ----> Do Page Change Src Seq + Number ....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8....+....9....+...10 Num Line Date Id Number + 234 D SQL_00059 167 169A CCSID(*JOBRUNMIX) COMPCD 000234 + 235 D SQL_00060 170 196A VARYING CCSID(*JOBRUNMIX) FILTER 000235 + 236 D SQL_00061 197 216A CCSID(*JOBRUNMIX) ELOT 000236 + Line <---------------------- Source Specifications -----------------------------------------------------> Do Change Src Seq + Number ....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8....+....9....+...10 Num Date Id Number + 237 **FREE 000237 + 238 **END-FREE 000238 + Line <---------------------- Source Specifications ----------------------------><---- Comments ----> Do Page Change Src Seq + Number ....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8....+....9....+...10 Num Line Date Id Number + 239 D DS DELETE 000239 + 240 D SQL_00062 1 2B 0 INZ(128) length of header 000240 + 241 D SQL_00063 3 4B 0 INZ(9) statement number 000241 + 242 D SQL_00064 5 8U 0 INZ(0) invocation mark 000242 + 243 D SQL_00065 9 9A INZ('0') CCSID(*JOBRUNMIX) data is okay 000243 + 244 D SQL_00066 10 127A CCSID(*JOBRUNMIX) end of header 000244 + 245 D SQL_00067 129 131A CCSID(*JOBRUNMIX) COMPCD 000245 + 246 D SQL_00068 132 158A VARYING CCSID(*JOBRUNMIX) FILTER 000246 + 247 D SQL_00069 159 178A CCSID(*JOBRUNMIX) SLOT 000247 + Line <---------------------- Source Specifications -----------------------------------------------------> Do Change Src Seq + Number ....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8....+....9....+...10 Num Date Id Number + 248 **FREE 000248 + 249=ILTSFL 1000001 + *--------------------------------------------------------------------------------------------* 1 + * RPG record format . . . . : LTSFL * 1 + * External format . . . . . : LTSFL : PERPDEMO/WRKLOTD * 1 + *--------------------------------------------------------------------------------------------* 1 + 250=I N 1 1 *IN03 Exit 1000002 + 251=I N 2 2 *IN05 Refresh 1000003 + 252=I N 3 3 *IN06 Add 1000004 + 253=I N 4 4 *IN12 Cancel 1000005 + 254=I A 5 5 SOPT 1000006 + 255=I A 6 25 SLOT 1000007 + 256=I S 26 40 4SQTY 1000008 + 257=I A 41 50 SRECV 1000009 + 258=I A 51 60 SEXPD 1000010 + 259=ILTCTL 2000001 + *--------------------------------------------------------------------------------------------* 2 + * RPG record format . . . . : LTCTL * 2 + * External format . . . . . : LTCTL : PERPDEMO/WRKLOTD * 2 + *--------------------------------------------------------------------------------------------* 2 + 260=I N 1 1 *IN03 Exit 2000002 + 261=I N 2 2 *IN05 Refresh 2000003 + 262=I N 3 3 *IN06 Add 2000004 + 263=I N 4 4 *IN12 Cancel 2000005 + 264=I A 5 29 SFITEM 2000006 + 265=ILTFOOT 3000001 + *--------------------------------------------------------------------------------------------* 3 + * RPG record format . . . . : LTFOOT * 3 + 5770WDS V7R5M0 220415 RN IBM ILE RPG PERPDEMO/WRKLOTR IDEV 08/26/26 16:51:50 Page 9 + Line <---------------------- Source Specifications -----------------------------------------------------> Do Change Src Seq + Number ....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8....+....9....+...10 Num Date Id Number + * External format . . . . . : LTFOOT : PERPDEMO/WRKLOTD * 3 + *--------------------------------------------------------------------------------------------* 3 + 266=I N 1 1 *IN03 Exit 3000002 + 267=I N 2 2 *IN05 Refresh 3000003 + 268=I N 3 3 *IN06 Add 3000004 + 269=I N 4 4 *IN12 Cancel 3000005 + 270=ILTNONE 4000001 + *--------------------------------------------------------------------------------------------* 4 + * RPG record format . . . . : LTNONE * 4 + * External format . . . . . : LTNONE : PERPDEMO/WRKLOTD * 4 + *--------------------------------------------------------------------------------------------* 4 + 271=I N 1 1 *IN03 Exit 4000002 + 272=I N 2 2 *IN05 Refresh 4000003 + 273=I N 3 3 *IN06 Add 4000004 + 274=I N 4 4 *IN12 Cancel 4000005 + 275=ILTNOITEM 5000001 + *--------------------------------------------------------------------------------------------* 5 + * RPG record format . . . . : LTNOITEM * 5 + * External format . . . . . : LTNOITEM : PERPDEMO/WRKLOTD * 5 + *--------------------------------------------------------------------------------------------* 5 + 276=I N 1 1 *IN03 Exit 5000002 + 277=I N 2 2 *IN05 Refresh 5000003 + 278=I N 3 3 *IN06 Add 5000004 + 279=I N 4 4 *IN12 Cancel 5000005 + 280=ILTEDIT 6000001 + *--------------------------------------------------------------------------------------------* 6 + * RPG record format . . . . : LTEDIT * 6 + * External format . . . . . : LTEDIT : PERPDEMO/WRKLOTD * 6 + *--------------------------------------------------------------------------------------------* 6 + 281=I N 1 1 *IN03 Exit 6000002 + 282=I N 2 2 *IN05 Refresh 6000003 + 283=I N 3 3 *IN06 Add 6000004 + 284=I N 4 4 *IN12 Cancel 6000005 + 285=I A 5 24 ELOT 6000006 + 286=I S 25 39 4EQTY 6000007 + 287=I A 40 49 ERECV 6000008 + 288=I A 50 59 EEXPD 6000009 + 289=I A 60 60 EACTIVE 6000010 + 290=ILTMSGSFL 7000001 + *--------------------------------------------------------------------------------------------* 7 + * RPG record format . . . . : LTMSGSFL * 7 + * External format . . . . . : LTMSGSFL : PERPDEMO/WRKLOTD * 7 + *--------------------------------------------------------------------------------------------* 7 + 291=I N 1 1 *IN03 Exit 7000002 + 292=I N 2 2 *IN05 Refresh 7000003 + 293=I N 3 3 *IN06 Add 7000004 + 294=I N 4 4 *IN12 Cancel 7000005 + 295=I A 5 8 SMSGKEY 7000006 + 296=I A 9 18 SPGMQ 7000007 + 297=ILTMSGCTL 8000001 + *--------------------------------------------------------------------------------------------* 8 + * RPG record format . . . . : LTMSGCTL * 8 + * External format . . . . . : LTMSGCTL : PERPDEMO/WRKLOTD * 8 + *--------------------------------------------------------------------------------------------* 8 + 298=I N 1 1 *IN03 Exit 8000002 + 299=I N 2 2 *IN05 Refresh 8000003 + 5770WDS V7R5M0 220415 RN IBM ILE RPG PERPDEMO/WRKLOTR IDEV 08/26/26 16:51:50 Page 10 + Line <---------------------- Source Specifications -----------------------------------------------------> Do Change Src Seq + Number ....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8....+....9....+...10 Num Date Id Number + 300=I N 3 3 *IN06 Add 8000004 + 301=I N 4 4 *IN12 Cancel 8000005 + 302 in ldaDS; 000249 + 303 compcd = ldaDS.compcd; 000250 + 304 000251 + 305 if %parms >= 1 and pCompcd <> ''; B01 000252 + 306 compcd = pCompcd; 01 000253 + 307 endif; E01 000254 + 308 scompdsp = compcd; 000255 + 309 filter = ''; 000256 + 310 if %parms >= 2 and pItem <> ''; B01 000257 + 311 filter = pItem; 01 000258 + 312 sfitem = pItem; 01 000259 + 313 else; X01 000260 + 314 sfitem = ''; 01 000261 + 315 endif; E01 000262 + 316 000263 + 317 if compcd = ''; B01 000264 + 318 exsr clearMsgs; 01 000265 + 319 writeMsg('No company selected - run Select Company (PERPSELR) first.'); 01 000266 + 320 endif; E01 000267 + 321 000268 + 322 dow not *in03 and not *in12; B01 000269 + 323 if compcd = ''; B02 000270 + 324 *in30 = *off; 02 000271 + 325 write ltnoitem; 02 000272 + 326 write ltfoot; 02 000273 + 327 if msgrrn > 0; B03 000274 + 328 *in40 = *on; 03 000275 + 329 write ltmsgctl; 03 000276 + 330 else; X03 000277 + 331 *in40 = *off; 03 000278 + 332 endif; E03 000279 + 333 exfmt ltctl; 02 000280 + 334 leave; 02 000281 + 335 endif; E02 000282 + 336 000283 + 337 // A message queued by an action handler below (addRow, etc.) must 000284 + 338 // survive one full loop pass before being cleared, or it never 000285 + 339 // reaches the screen -- clearMsgs wipes msgrrn back to 0 on the very 000286 + 340 // next pass, before this pass's own exfmt ever shows it. holdMsg 000287 + 341 // skips exactly one clearMsgs call right after such a message was 000288 + 342 // queued. Same pattern as wrkitmr. 000289 + 343 if holdMsg; B02 000290 + 344 holdMsg = *off; 02 000291 + 345 else; X02 000292 + 346 exsr clearMsgs; 02 000293 + 347 endif; E02 000294 + 348 000295 + 349 if filter = ''; B02 000296 + 350 *in30 = *off; 02 000297 + 351 *in60 = *off; 02 000298 + 352 numRows = 0; 02 000299 + 353 sioh = 0; 02 000300 + 5770WDS V7R5M0 220415 RN IBM ILE RPG PERPDEMO/WRKLOTR IDEV 08/26/26 16:51:50 Page 11 + Line <---------------------- Source Specifications -----------------------------------------------------> Do Change Src Seq + Number ....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8....+....9....+...10 Num Date Id Number + 354 slottot = 0; 02 000301 + 355 write ltnoitem; 02 000302 + 356 else; X02 000303 + 357 exsr loadBalances; 02 000304 + 358 exsr loadRows; 02 000305 + 359 if numRows = 0; B03 000306 + 360 *in30 = *off; 03 000307 + 361 write ltnone; 03 000308 + 362 else; X03 000309 + 363 exsr fillSubfile; 03 000310 + 364 *in30 = *on; 03 000311 + 365 endif; E03 000312 + 366 endif; E02 000313 + 367 000314 + 368 write ltfoot; 01 000315 + 369 if msgrrn > 0; B02 000316 + 370 *in40 = *on; 02 000317 + 371 write ltmsgctl; 02 000318 + 372 else; X02 000319 + 373 *in40 = *off; 02 000320 + 374 endif; E02 000321 + 375 exfmt ltctl; 01 000322 + 376 000323 + 377 if *in03 or *in12; B02 000324 + 378 leave; 02 000325 + 379 endif; E02 000326 + 380 000327 + 381 if *in05; B02 000328 + 382 filter = sfitem; 02 000329 + 383 iter; 02 000330 + 384 endif; E02 000331 + 385 000332 + 386 if *in06; B02 000333 + 387 if sfitem = ''; B03 000334 + 388 writeMsg('Enter an item number before adding a lot.'); 03 000335 + 389 holdMsg = *on; 03 000336 + 390 else; X03 000337 + 391 filter = sfitem; 03 000338 + 392 exsr addRow; 03 000339 + 393 endif; E03 000340 + 394 iter; 02 000341 + 395 endif; E02 000342 + 396 000343 + 397 // Item Number prompt (PERP-60): '?' + Enter invokes the standard 000344 + 398 // reusable Item Number lookup (PERP-56) and returns the selection. 000345 + 399 if %trim(sfitem) = '?'; B02 000346 + 400 promptItem = sfitem; 02 000347 + 401 callItmprmt(compcd : promptItem); 02 000348 + 402 sfitem = promptItem; 02 000349 + 403 filter = promptItem; 02 000350 + 404 iter; 02 000351 + 405 endif; E02 000352 + 406 000353 + 407 // Refresh scope from screen entry 000354 + 408 if sfitem <> filter; B02 000355 + 409 filter = sfitem; 02 000356 + 5770WDS V7R5M0 220415 RN IBM ILE RPG PERPDEMO/WRKLOTR IDEV 08/26/26 16:51:50 Page 12 + Line <---------------------- Source Specifications -----------------------------------------------------> Do Change Src Seq + Number ....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8....+....9....+...10 Num Date Id Number + 410 iter; 02 000357 + 411 endif; E02 000358 + 412 000359 + 413 // Process subfile options. Guard on numRows: READC against a subfile 000360 + 414 // that was never written to this cycle (0 rows loaded) raises a 000361 + 415 // "Session or device error" (CPF5006-class) runtime error instead of 000362 + 416 // just returning *EOF. 000363 + 417 if numRows > 0; B02 000364 + 418 selRrn = 0; 02 000365 + 419 selOpt = ' '; 02 000366 + 420 readc ltsfl; 02 000367 + 421 dow not %eof(wrklotd); B03 000368 + 422 if sopt <> ''; B04 000369 + 423 selRrn = rrn; 04 000370 + 424 selOpt = sopt; 04 000371 + 425 exsr handleOpt; 04 000372 + 426 selRrn = 0; 04 000373 + 427 endif; E04 000374 + 428 readc ltsfl; 03 000375 + 429 enddo; E03 000376 + 430 endif; E02 000377 + 431 000378 + 432 enddo; E01 000379 + 433 000380 + 434 *inlr = *on; 000381 + 435 return; 000382 + 436 000383 + 437 // --------------------------------------------------------------------- 000384 + 438 begsr loadBalances; 000385 + 439 //* exec sql 000386 + 440 //* select qty_on_hand into :itemOh 000387 + 441 //* from perpdemo.item 000388 + 442 //* where company_code = :compcd and item_number = :filter; 000389 + 443 SQL_00005 = COMPCD; //SQL 000390 + 444 SQL_00006 = FILTER; //SQL 000391 + 445 SQLER6 = -4; //SQL 2 000392 + 446 SQLROUTE_CALL( //SQL 000393 + 447 SQLCA //SQL 000394 + 448 : SQL_00000 //SQL 000395 + 449 ); //SQL 000396 + 450 IF SQL_00003 = '1'; //SQL B01 000397 + 451 EVAL ITEMOH = SQL_00007; //SQL 01 000398 + 452 ENDIF; //SQL E01 000399 + 453 if sqlcode <> 0; B01 000400 + 454 itemOh = 0; 01 000401 + 455 endif; E01 000402 + 456 //* exec sql 000403 + 457 //* select coalesce(sum(qty_on_hand), 0) into :lotTotal 000404 + 458 //* from perpdemo.item_lot 000405 + 459 //* where company_code = :compcd and item_number = :filter; 000406 + 460 SQL_00013 = COMPCD; //SQL 000407 + 461 SQL_00014 = FILTER; //SQL 000408 + 462 SQLER6 = -4; //SQL 3 000409 + 463 SQLROUTE_CALL( //SQL 000410 + 464 SQLCA //SQL 000411 + 465 : SQL_00008 //SQL 000412 + 5770WDS V7R5M0 220415 RN IBM ILE RPG PERPDEMO/WRKLOTR IDEV 08/26/26 16:51:50 Page 13 + Line <---------------------- Source Specifications -----------------------------------------------------> Do Change Src Seq + Number ....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8....+....9....+...10 Num Date Id Number + 466 ); //SQL 000413 + 467 IF SQL_00011 = '1'; //SQL B01 000414 + 468 EVAL LOTTOTAL = SQL_00015; //SQL 01 000415 + 469 ENDIF; //SQL E01 000416 + 470 sioh = itemOh; 000417 + 471 slottot = lotTotal; 000418 + 472 if itemOh <> lotTotal; B01 000419 + 473 *in60 = *on; 01 000420 + 474 else; X01 000421 + 475 *in60 = *off; 01 000422 + 476 endif; E01 000423 + 477 endsr; 000424 + 478 000425 + 479 // --------------------------------------------------------------------- 000426 + 480 begsr loadRows; 000427 + 481 numRows = 0; 000428 + 482 // PERP-84: display as MM/DD/YY. received_date/expiry_date are stored 000429 + 483 // as native DATE columns but rendered here as plain strings (SRECV/ 000430 + 484 // SEXPD carry no DATFMT keyword), so the format has to be built by 000431 + 485 // hand from the ISO string -- DB2 for i's CHAR(date,fmt) built-in 000432 + 486 // formats (ISO/USA/EUR/JIS) all use a 4-digit year, none produce a 000433 + 487 // 2-digit year directly. Same technique as wrkivpr.sqlrpgle (PERP-83). 000434 + 488 //* exec sql declare c1 cursor for 000435 + 489 //* select lot_number, qty_on_hand, 000436 + 490 //* substr(char(received_date, iso), 6, 2) || '/' 000437 + 491 //* || substr(char(received_date, iso), 9, 2) || '/' 000438 + 492 //* || substr(char(received_date, iso), 3, 2), 000439 + 493 //* case when expiry_date is null then '' 000440 + 494 //* else substr(char(expiry_date, iso), 6, 2) || '/' 000441 + 495 //* || substr(char(expiry_date, iso), 9, 2) || '/' 000442 + 496 //* || substr(char(expiry_date, iso), 3, 2) 000443 + 497 //* end 000444 + 498 //* from perpdemo.item_lot 000445 + 499 //* where company_code = :compcd and item_number = :filter 000446 + 500 //* order by lot_number; 000447 + 501 //* exec sql open c1; 000448 + 502 SQL_00021 = COMPCD; //SQL 000449 + 503 SQL_00022 = FILTER; //SQL 000450 + 504 SQLER6 = -4; //SQL 000451 + 505 IF SQL_00018 = 0 //SQL B01 000452 + 506 OR SQL_00019 <> *LOVAL; //SQL B01 000453 + 507 SQLROUTE_CALL( //SQL 01 000454 + 508 SQLCA //SQL 01 000455 + 509 : SQL_00016 //SQL 01 000456 + 510 ); //SQL 01 000457 + 511 ELSE; //SQL X01 000458 + 512 SQLOPEN_CALL( //SQL 01 000459 + 513 SQLCA //SQL 01 000460 + 514 : SQL_00016 //SQL 01 000461 + 515 ); //SQL 01 000462 + 516 ENDIF; //SQL E01 000463 + 517 if sqlcode < 0; B01 000464 + 518 writeMsg('SQL open failed: SQLCODE=' + %char(sqlcode)); 01 000465 + 519 leavesr; 01 000466 + 520 endif; E01 000467 + 521 000468 + 5770WDS V7R5M0 220415 RN IBM ILE RPG PERPDEMO/WRKLOTR IDEV 08/26/26 16:51:50 Page 14 + Line <---------------------- Source Specifications -----------------------------------------------------> Do Change Src Seq + Number ....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8....+....9....+...10 Num Date Id Number + 522 dow numRows < %elem(rows); B01 000469 + 523 //* exec sql fetch c1 into :ltRow; 000470 + 524 SQLER6 = -4; //SQL 5 01 000471 + 525 SQLROUTE_CALL( //SQL 01 000472 + 526 SQLCA //SQL 01 000473 + 527 : SQL_00023 //SQL 01 000474 + 528 ); //SQL 01 000475 + 529 IF SQL_00026 = '1'; //SQL B02 000476 + 530 EVAL LTROW.LOT = SQL_00028; //SQL 02 000477 + 531 EVAL LTROW.QTY = SQL_00029; //SQL 02 000478 + 532 EVAL LTROW.RECV = SQL_00030; //SQL 02 000479 + 533 EVAL LTROW.EXPD = SQL_00031; //SQL 02 000480 + 534 ENDIF; //SQL E02 000481 + 535 if sqlcode = 100 or sqlcode < 0; B02 000482 + 536 leave; 02 000483 + 537 endif; E02 000484 + 538 numRows += 1; 01 000485 + 539 rows(numRows) = ltRow; 01 000486 + 540 enddo; E01 000487 + 541 //* exec sql close c1; 000488 + 542 SQLER6 = 6; //SQL 000489 + 543 IF SQL_00034 = 0; //SQL B01 000490 + 544 SQLROUTE_CALL( //SQL 01 000491 + 545 SQLCA //SQL 01 000492 + 546 : SQL_00032 //SQL 01 000493 + 547 ); //SQL 01 000494 + 548 ELSE; //SQL X01 000495 + 549 SQLCLSE_CALL( //SQL 01 000496 + 550 SQLCA //SQL 01 000497 + 551 : SQL_00032 //SQL 01 000498 + 552 ); //SQL 01 000499 + 553 ENDIF; //SQL E01 000500 + 554 endsr; 000501 + 555 000502 + 556 // --------------------------------------------------------------------- 000503 + 557 begsr fillSubfile; 000504 + 558 rrn = 0; 000505 + 559 *in31 = *on; 000506 + 560 write ltctl; 000507 + 561 *in31 = *off; 000508 + 562 for i = 1 to numRows; B01 000509 + 563 *in50 = *off; 01 000510 + 564 *in51 = *off; 01 000511 + 565 sopt = ''; 01 000512 + 566 slot = rows(i).lot; 01 000513 + 567 sqty = rows(i).qty; 01 000514 + 568 srecv = rows(i).recv; 01 000515 + 569 sexpd = rows(i).expd; 01 000516 + 570 rrn += 1; 01 000517 + 571 write ltsfl; 01 000518 + 572 endfor; E01 000519 + 573 endsr; 000520 + 574 000521 + 575 // --------------------------------------------------------------------- 000522 + 576 begsr handleOpt; 000523 + 577 chain selRrn ltsfl; 000524 + 5770WDS V7R5M0 220415 RN IBM ILE RPG PERPDEMO/WRKLOTR IDEV 08/26/26 16:51:50 Page 15 + Line <---------------------- Source Specifications -----------------------------------------------------> Do Change Src Seq + Number ....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8....+....9....+...10 Num Date Id Number + 578 if %found(wrklotd); B01 000525 + 579 select; B02 000526 + 580 when selOpt = '2'; X02 000527 + 581 exsr changeRow; 02 000528 + 582 when selOpt = '4'; X02 000529 + 583 exsr deleteRow; 02 000530 + 584 other; X02 000531 + 585 writeMsg('Option ' + selOpt + ' not valid.'); 02 000532 + 586 holdMsg = *on; 02 000533 + 587 endsl; E02 000534 + 588 endif; E01 000535 + 589 endsr; 000536 + 590 000537 + 591 // --------------------------------------------------------------------- 000538 + 592 begsr addRow; 000539 + 593 exsr clearMsgs; 000540 + 594 emode = 'A'; 000541 + 595 elot = ''; 000542 + 596 eqty = 0; 000543 + 597 erecv = %char(%date():*mdy); 000544 + 598 eexpd = ''; 000545 + 599 eactive = 'Y'; 000546 + 600 exsr editLoop; 000547 + 601 if not *in12 and elot <> ''; B01 000548 + 602 //* exec sql 000549 + 603 //* insert into perpdemo.item_lot 000550 + 604 //* (company_code, item_number, lot_number, qty_on_hand, received_date, expiry_date) 000551 + 605 //* values (:compcd, :filter, :elot, :eqty, date(:erecv), 000552 + 606 //* case when :eexpd = '' then null else date(:eexpd) end); 000553 + 607 SQL_00043 = COMPCD; //SQL 01 000554 + 608 SQL_00044 = FILTER; //SQL 01 000555 + 609 SQL_00045 = ELOT; //SQL 01 000556 + 610 SQL_00046 = EQTY; //SQL 01 000557 + 611 SQL_00047 = ERECV; //SQL 01 000558 + 612 SQL_00048 = EEXPD; //SQL 01 000559 + 613 SQL_00049 = EEXPD; //SQL 01 000560 + 614 SQLER6 = -4; //SQL 7 01 000561 + 615 SQLROUTE_CALL( //SQL 01 000562 + 616 SQLCA //SQL 01 000563 + 617 : SQL_00038 //SQL 01 000564 + 618 ); //SQL 01 000565 + 619 if sqlcode < 0; B02 000566 + 620 writeMsg('Add failed: SQLCODE=' + %char(sqlcode) 02 000567 + 621 + ' SQLSTATE=' + sqlstate); 02 000568 + 622 else; X02 000569 + 623 writeMsg('Added lot ' + %trim(elot) + '.'); 02 000570 + 624 endif; E02 000571 + 625 holdMsg = *on; 01 000572 + 626 endif; E01 000573 + 627 endsr; 000574 + 628 000575 + 629 // --------------------------------------------------------------------- 000576 + 630 begsr changeRow; 000577 + 631 exsr clearMsgs; 000578 + 632 emode = 'C'; 000579 + 633 elot = slot; 000580 + 5770WDS V7R5M0 220415 RN IBM ILE RPG PERPDEMO/WRKLOTR IDEV 08/26/26 16:51:50 Page 16 + Line <---------------------- Source Specifications -----------------------------------------------------> Do Change Src Seq + Number ....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8....+....9....+...10 Num Date Id Number + 634 eqty = sqty; 000581 + 635 erecv = srecv; 000582 + 636 eexpd = sexpd; 000583 + 637 eactive = 'Y'; 000584 + 638 exsr editLoop; 000585 + 639 if not *in12; B01 000586 + 640 //* exec sql 000587 + 641 //* update perpdemo.item_lot 000588 + 642 //* set qty_on_hand = :eqty, 000589 + 643 //* received_date = date(:erecv), 000590 + 644 //* expiry_date = case when :eexpd = '' then null else date(:eexpd) end, 000591 + 645 //* updated_at = current_timestamp, 000592 + 646 //* updated_by = user 000593 + 647 //* where company_code = :compcd and item_number = :filter and lot_number = :elot; 000594 + 648 SQL_00055 = EQTY; //SQL 01 000595 + 649 SQL_00056 = ERECV; //SQL 01 000596 + 650 SQL_00057 = EEXPD; //SQL 01 000597 + 651 SQL_00058 = EEXPD; //SQL 01 000598 + 652 SQL_00059 = COMPCD; //SQL 01 000599 + 653 SQL_00060 = FILTER; //SQL 01 000600 + 654 SQL_00061 = ELOT; //SQL 01 000601 + 655 SQLER6 = -4; //SQL 8 01 000602 + 656 SQLROUTE_CALL( //SQL 01 000603 + 657 SQLCA //SQL 01 000604 + 658 : SQL_00050 //SQL 01 000605 + 659 ); //SQL 01 000606 + 660 if sqlcode < 0; B02 000607 + 661 writeMsg('Change failed: SQLCODE=' + %char(sqlcode)); 02 000608 + 662 else; X02 000609 + 663 writeMsg('Updated lot ' + %trim(elot) + '.'); 02 000610 + 664 endif; E02 000611 + 665 holdMsg = *on; 01 000612 + 666 endif; E01 000613 + 667 endsr; 000614 + 668 000615 + 669 // --------------------------------------------------------------------- 000616 + 670 begsr deleteRow; 000617 + 671 exsr clearMsgs; 000618 + 672 //* exec sql 000619 + 673 //* delete from perpdemo.item_lot 000620 + 674 //* where company_code = :compcd and item_number = :filter and lot_number = :slot; 000621 + 675 SQL_00067 = COMPCD; //SQL 000622 + 676 SQL_00068 = FILTER; //SQL 000623 + 677 SQL_00069 = SLOT; //SQL 000624 + 678 SQLER6 = -4; //SQL 9 000625 + 679 SQLROUTE_CALL( //SQL 000626 + 680 SQLCA //SQL 000627 + 681 : SQL_00062 //SQL 000628 + 682 ); //SQL 000629 + 683 if sqlcode < 0; B01 000630 + 684 writeMsg('Delete failed: SQLSTATE=' + sqlstate); 01 000631 + 685 else; X01 000632 + 686 writeMsg('Deleted lot ' + %trim(slot) + '.'); 01 000633 + 687 endif; E01 000634 + 688 holdMsg = *on; 000635 + 689 endsr; 000636 + 5770WDS V7R5M0 220415 RN IBM ILE RPG PERPDEMO/WRKLOTR IDEV 08/26/26 16:51:50 Page 17 + Line <---------------------- Source Specifications -----------------------------------------------------> Do Change Src Seq + Number ....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8....+....9....+...10 Num Date Id Number + 690 000637 + 691 // --------------------------------------------------------------------- 000638 + 692 // PERP-84: erecv/eexpd are typed by the user as MM/DD/YY on LTEDIT. 000639 + 693 // Validate on every Enter; on failure, show the error in the message 000640 + 694 // subfile alongside LTEDIT and let the user retry (never crash into 000641 + 695 // the SQL date(:erecv) cast in addRow/changeRow with unparsed text). 000642 + 696 // On success, erecv/eexpd are normalized to ISO ('yyyy-mm-dd') text so 000643 + 697 // the existing date(:erecv)/date(:eexpd) SQL casts in addRow/changeRow 000644 + 698 // keep working unchanged. 000645 + 699 begsr editLoop; 000646 + 700 exsr clearMsgs; 000647 + 701 dow *on; B01 000648 + 702 if msgrrn > 0; B02 000649 + 703 *in40 = *on; 02 000650 + 704 write ltmsgctl; 02 000651 + 705 else; X02 000652 + 706 *in40 = *off; 02 000653 + 707 endif; E02 000654 + 708 exfmt ltedit; 01 000655 + 709 000656 + 710 if *in12; B02 000657 + 711 leave; 02 000658 + 712 endif; E02 000659 + 713 000660 + 714 exsr clearMsgs; 01 000661 + 715 000662 + 716 if %trim(elot) = ''; B02 000663 + 717 writeMsg('Lot Number is required.'); 02 000664 + 718 iter; 02 000665 + 719 endif; E02 000666 + 720 000667 + 721 if %trim(erecv) = ''; B02 000668 + 722 writeMsg('Received Date is required (MM/DD/YY).'); 02 000669 + 723 iter; 02 000670 + 724 endif; E02 000671 + 725 000672 + 726 validRecv = *on; 01 000673 + 727 monitor; B02 000674 + 728 parsedRecv = %date(%trim(erecv):*mdy); 02 000675 + 729 on-error; X02 000676 + 730 validRecv = *off; 02 000677 + 731 endmon; E02 000678 + 732 if not validRecv; B02 000679 + 733 writeMsg('Invalid Received Date - enter as MM/DD/YY.'); 02 000680 + 734 iter; 02 000681 + 735 endif; E02 000682 + 736 000683 + 737 validExpd = *on; 01 000684 + 738 if %trim(eexpd) <> ''; B02 000685 + 739 monitor; B03 000686 + 740 parsedExpd = %date(%trim(eexpd):*mdy); 03 000687 + 741 on-error; X03 000688 + 742 validExpd = *off; 03 000689 + 743 endmon; E03 000690 + 744 endif; E02 000691 + 745 if not validExpd; B02 000692 + 5770WDS V7R5M0 220415 RN IBM ILE RPG PERPDEMO/WRKLOTR IDEV 08/26/26 16:51:50 Page 18 + Line <---------------------- Source Specifications -----------------------------------------------------> Do Change Src Seq + Number ....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8....+....9....+...10 Num Date Id Number + 746 writeMsg('Invalid Expiry Date - enter as MM/DD/YY, or blank for none.'); 02 000693 + 747 iter; 02 000694 + 748 endif; E02 000695 + 749 000696 + 750 erecv = %char(parsedRecv:*iso); 01 000697 + 751 if %trim(eexpd) <> ''; B02 000698 + 752 eexpd = %char(parsedExpd:*iso); 02 000699 + 753 endif; E02 000700 + 754 000701 + 755 leave; 01 000702 + 756 enddo; E01 000703 + 757 endsr; 000704 + 758 000705 + 759 // --------------------------------------------------------------------- 000706 + 760 begsr clearMsgs; 000707 + 761 msgrrn = 0; 000708 + 762 *in41 = *on; 000709 + 763 write ltmsgctl; 000710 + 764 *in41 = *off; 000711 + 765 endsr; 000712 + 766 000713 + 767 // --------------------------------------------------------------------- 000714 + 768=OLTSFL 9000001 + *--------------------------------------------------------------------------------------------* 9 + * RPG record format . . . . : LTSFL * 9 + * External format . . . . . : LTSFL : PERPDEMO/WRKLOTD * 9 + *--------------------------------------------------------------------------------------------* 9 + 769=O *IN50 2N CHAR 1 9000002 + 770=O *IN51 1N CHAR 1 9000003 + 771=O SOPT 3A CHAR 1 9000004 + 772=O SLOT 23A CHAR 20 9000005 + 773=O SQTY 38S ZONE 15,4 9000006 + 774=O SRECV 48A CHAR 10 9000007 + 775=O SEXPD 58A CHAR 10 9000008 + 776=OLTCTL 10000001 + *--------------------------------------------------------------------------------------------* 10 + * RPG record format . . . . : LTCTL * 10 + * External format . . . . . : LTCTL : PERPDEMO/WRKLOTD * 10 + *--------------------------------------------------------------------------------------------* 10 + 777=O *IN30 2N CHAR 1 10000002 + 778=O *IN31 1N CHAR 1 10000003 + 779=O *IN60 3N CHAR 1 10000004 + 780=O SCOMPDSP 6A CHAR 3 10000005 + 781=O SFITEM 31A CHAR 25 10000006 + 782=O SIOH 46S ZONE 15,4 10000007 + 783=O SLOTTOT 61S ZONE 15,4 10000008 + 784=OLTFOOT 11000001 + *--------------------------------------------------------------------------------------------* 11 + * RPG record format . . . . : LTFOOT * 11 + * External format . . . . . : LTFOOT : PERPDEMO/WRKLOTD * 11 + *--------------------------------------------------------------------------------------------* 11 + 785=OLTNONE 12000001 + *--------------------------------------------------------------------------------------------* 12 + * RPG record format . . . . : LTNONE * 12 + 5770WDS V7R5M0 220415 RN IBM ILE RPG PERPDEMO/WRKLOTR IDEV 08/26/26 16:51:50 Page 19 + Line <---------------------- Source Specifications -----------------------------------------------------> Do Change Src Seq + Number ....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8....+....9....+...10 Num Date Id Number + * External format . . . . . : LTNONE : PERPDEMO/WRKLOTD * 12 + *--------------------------------------------------------------------------------------------* 12 + 786=OLTNOITEM 13000001 + *--------------------------------------------------------------------------------------------* 13 + * RPG record format . . . . : LTNOITEM * 13 + * External format . . . . . : LTNOITEM : PERPDEMO/WRKLOTD * 13 + *--------------------------------------------------------------------------------------------* 13 + 787=OLTEDIT 14000001 + *--------------------------------------------------------------------------------------------* 14 + * RPG record format . . . . : LTEDIT * 14 + * External format . . . . . : LTEDIT : PERPDEMO/WRKLOTD * 14 + *--------------------------------------------------------------------------------------------* 14 + 788=O EMODE 1A CHAR 1 14000002 + 789=O ELOT 21A CHAR 20 14000003 + 790=O EQTY 36S ZONE 15,4 14000004 + 791=O ERECV 46A CHAR 10 14000005 + 792=O EEXPD 56A CHAR 10 14000006 + 793=O EACTIVE 57A CHAR 1 14000007 + 794=OLTMSGSFL 15000001 + *--------------------------------------------------------------------------------------------* 15 + * RPG record format . . . . : LTMSGSFL * 15 + * External format . . . . . : LTMSGSFL : PERPDEMO/WRKLOTD * 15 + *--------------------------------------------------------------------------------------------* 15 + 795=O SMSGKEY 4A CHAR 4 15000002 + 796=O SPGMQ 14A CHAR 10 15000003 + 797=OLTMSGCTL 16000001 + *--------------------------------------------------------------------------------------------* 16 + * RPG record format . . . . : LTMSGCTL * 16 + * External format . . . . . : LTMSGCTL : PERPDEMO/WRKLOTD * 16 + *--------------------------------------------------------------------------------------------* 16 + 798=O *IN40 2N CHAR 1 16000002 + 799=O *IN41 1N CHAR 1 16000003 + 800 dcl-proc writeMsg; 000715 + 801 dcl-pi *n; 000716 + 802 text varchar(256) const; 000717 + 803 end-pi; 000718 + 804 dcl-s data char(256); 000719 + 805 data = text; 000720 + 806 QMHSNDPM( 000721 + 807 'CPF9897' : 000722 + 808 'QCPFMSG QSYS ' : 000723 + 809 data : 000724 + 810 %len(text) : 000725 + 811 '*INFO ' : 000726 + 812 '* ' : 000727 + 813 1 : 000728 + 814 smsgkey : 000729 + 815 x'0000000000000000'); 000730 + 816 msgrrn += 1; 000731 + 817 spgmq = statusDS.programName; 000732 + 818 write ltmsgsfl; 000733 + 819 end-proc; 000734 + 5770WDS V7R5M0 220415 RN IBM ILE RPG PERPDEMO/WRKLOTR IDEV 08/26/26 16:51:50 Page 20 + Line <---------------------- Source Specifications -----------------------------------------------------> Do Change Src Seq + Number ....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8....+....9....+...10 Num Date Id Number + * * * * * E N D O F S O U R C E * * * * * + 5770WDS V7R5M0 220415 RN IBM ILE RPG PERPDEMO/WRKLOTR IDEV 08/26/26 16:51:50 Page 21 + A d d i t i o n a l D i a g n o s t i c M e s s a g e s + Msg id Sv Number Seq Message text + * * * * * E N D O F A D D I T I O N A L D I A G N O S T I C M E S S A G E S * * * * * + O u t p u t B u f f e r P o s i t i o n s + Line Start End Field or Constant + Number Pos Pos + 769 2 2 *IN50 + 770 1 1 *IN51 + 771 3 3 SOPT + 772 4 23 SLOT + 773 24 38 SQTY + 774 39 48 SRECV + 775 49 58 SEXPD + 769 2 2 *IN50 + 770 1 1 *IN51 + 771 3 3 SOPT + 772 4 23 SLOT + 773 24 38 SQTY + 774 39 48 SRECV + 775 49 58 SEXPD + 777 2 2 *IN30 + 778 1 1 *IN31 + 779 3 3 *IN60 + 780 4 6 SCOMPDSP + 781 7 31 SFITEM + 782 32 46 SIOH + 783 47 61 SLOTTOT + 777 2 2 *IN30 + 778 1 1 *IN31 + 779 3 3 *IN60 + 780 4 6 SCOMPDSP + 781 7 31 SFITEM + 782 32 46 SIOH + 783 47 61 SLOTTOT + 788 1 1 EMODE + 789 2 21 ELOT + 790 22 36 EQTY + 791 37 46 ERECV + 792 47 56 EEXPD + 793 57 57 EACTIVE + 788 1 1 EMODE + 789 2 21 ELOT + 790 22 36 EQTY + 791 37 46 ERECV + 792 47 56 EEXPD + 793 57 57 EACTIVE + 795 1 4 SMSGKEY + 796 5 14 SPGMQ + 795 1 4 SMSGKEY + 796 5 14 SPGMQ + 798 2 2 *IN40 + 799 1 1 *IN41 + 5770WDS V7R5M0 220415 RN IBM ILE RPG PERPDEMO/WRKLOTR IDEV 08/26/26 16:51:50 Page 22 + 798 2 2 *IN40 + 799 1 1 *IN41 + * * * * * E N D O F O U T P U T B U F F E R P O S I T I O N * * * * * + 5770WDS V7R5M0 220415 RN IBM ILE RPG PERPDEMO/WRKLOTR IDEV 08/26/26 16:51:50 Page 23 + C r o s s R e f e r e n c e + File and Record References: + File Device References (D=Defined) + Record + WRKLOTD WORKSTN 28D 421 578 + LTSFL 28D 249 420 428 + 571 577 768 + LTCTL 28D 259 333 375 + 560 776 + LTFOOT 28D 265 326 368 + 784 + LTNONE 28D 270 361 785 + LTNOITEM 28D 275 325 355 + 786 + LTEDIT 28D 280 708 787 + LTMSGSFL 28D 290 794 818 + LTMSGCTL 28D 297 329 371 + 704 763 797 + Global Field References: + Field Attributes References (D=Defined M=Modified) + *INLR N(1) 434M + *IN03 N(1) 250D 260M 266M 271M + 276M 281M 291M 298M + 322 377 + *IN05 N(1) 251D 261M 267M 272M + 277M 282M 292M 299M + 381 + *IN06 N(1) 252D 262M 268M 273M + 278M 283M 293M 300M + 386 + *IN12 N(1) 253D 263M 269M 274M + 279M 284M 294M 301M + 322 377 601 639 + 710 + *IN30 N(1) 324M 350M 360M 364M + 777 + *IN31 N(1) 559M 561M 778 + *IN40 N(1) 328M 331M 370M 373M + 703M 706M 798 + *IN41 N(1) 762M 764M 799 + *IN50 N(1) 563M 769 + *IN51 N(1) 564M 770 + *IN60 N(1) 351M 473M 475M 779 + ADDROW BEGSR 392 592D + CALLITMPRMT PROTOTYPE 48D 401M + CHANGEROW BEGSR 581 630D + CLEARMSGS BEGSR 318 346 593 631 + 671 700 714 760D + COMPCD A(3) 73D 303M 306M 308 + 317 323 401 443 + 460 502 607 652 + 675 + DELETEROW BEGSR 583 670D + EACTIVE A(1) 289M 599M 637M 793 + 5770WDS V7R5M0 220415 RN IBM ILE RPG PERPDEMO/WRKLOTR IDEV 08/26/26 16:51:50 Page 24 + EDITLOOP BEGSR 600 638 699D + EEXPD A(10) 288M 598M 612 613 + 636M 650 651 738 + 740 751 752M 792 + ELOT A(20) 285M 595M 601 609 + 623 633M 654 663 + 716 789 + EMODE A(1) 594M 632M 788 + EQTY P(15,4) 286M 596M 610 634M + 648 790 + ERECV A(10) 287M 597M 611 635M + 649 721 728 750M + 791 + FILLSUBFILE BEGSR 363 557D + FILTER A(25) 72D 309M 311M 349 + VARYING(2) 382M 391M 403M 408 + 409M 444 461 503 + 608 653 676 + HANDLEOPT BEGSR 425 576D + HOLDMSG N(1) 77D 343 344M 389M + 586M 625M 665M 688M + I I(10,0) 66D 562 566 567 + 568 569 + ITEMOH P(15,4) 74D 451M 454M 470 + 472 + LDADS DS(1024) 30D 302 303 + COMPCD A(3) 31D 303 + LOADBALANCES BEGSR 357 438D + LOADROWS BEGSR 358 480D + LOTTOTAL P(15,4) 75D 468M 471 472 + LTROW DS(54) 57D 64 530M 531M + 532M 533M 539 + EXPD A(10) 61D 533 + VARYING(2) + LOT A(20) 58D 530 + VARYING(2) + QTY P(15,4) 59D 531 + RECV A(10) 60D 532 + VARYING(2) + *RNF7031 MSGKEY A(4) 69D + MSGRRN I(10,0) 28 68D 327 369 + 702 761M 816M + NUMROWS I(10,0) 65D 352M 359 417 + 481M 522 538M 539 + 562 + PARSEDEXPD D(10*ISO-) 86D 740M 752 + PARSEDRECV D(10*ISO-) 85D 728M 750 + PCOMPCD A(3) 24D 305 306 + BASED(_QRNL_PRM+) + PITEM A(25) 25D 310 311 312 + BASED(_QRNL_PRM+) + VARYING(2) + PROMPTITEM A(25) 76D 400M 401 402 + VARYING(2) 403 + QMHSNDPM PROTOTYPE 34D 806M + ROWS(500) DS(54) 64D 522 539M 566 + 567 568 569 + EXPD A(10) 569 + 5770WDS V7R5M0 220415 RN IBM ILE RPG PERPDEMO/WRKLOTR IDEV 08/26/26 16:51:50 Page 25 + VARYING(2) + LOT A(20) 566 + VARYING(2) + QTY P(15,4) 567 + RECV A(10) 568 + VARYING(2) + RRN I(10,0) 28 67D 423 558M + 570M + SCOMPDSP A(3) 308M 780 + SELOPT A(1) 71D 419M 424M 580 + 582 585 + SELRRN I(10,0) 70D 418M 423M 426M + 577 + SEXPD A(10) 258M 569M 636 775 + SFITEM A(25) 264M 312M 314M 382 + 387 391 399 400 + 402M 408 409 781 + SIOH P(15,4) 353M 470M 782 + SLOT A(20) 255M 566M 633 677 + 686 772 + SLOTTOT P(15,4) 354M 471M 783 + SMSGKEY A(4) 295M 795 814 + SOPT A(1) 254M 422 424 565M + 771 + SPGMQ A(10) 296M 796 817M + *RNF7031 SQFAPP CONST 154D + *RNF7031 SQFCRT CONST 152D + *RNF7031 SQFOVR CONST 153D + *RNF7031 SQFRD CONST 151D + SQL_00000 B(4,0) 157D 448 + *RNF7031 SQL_00001 B(4,0) 158D + *RNF7031 SQL_00002 U(10,0) 159D + SQL_00003 A(1) 160D 450 + *RNF7031 SQL_00004 A(119) 161D + SQL_00005 A(3) 162D 443M + SQL_00006 A(25) 163D 444M + VARYING(2) + SQL_00007 P(15,4) 164D 451 + SQL_00008 B(4,0) 168D 465 + *RNF7031 SQL_00009 B(4,0) 169D + *RNF7031 SQL_00010 U(10,0) 170D + SQL_00011 A(1) 171D 467 + *RNF7031 SQL_00012 A(119) 172D + SQL_00013 A(3) 173D 460M + SQL_00014 A(25) 174D 461M + VARYING(2) + SQL_00015 P(15,4) 175D 468 + SQL_00016 B(4,0) 179D 509 514 + *RNF7031 SQL_00017 B(4,0) 180D + SQL_00018 U(10,0) 181D 505 + SQL_00019 A(1) 182D 506 + *RNF7031 SQL_00020 A(119) 183D + SQL_00021 A(3) 184D 502M + SQL_00022 A(25) 185D 503M + VARYING(2) + SQL_00023 B(4,0) 189D 527 + *RNF7031 SQL_00024 B(4,0) 190D + *RNF7031 SQL_00025 U(10,0) 191D + 5770WDS V7R5M0 220415 RN IBM ILE RPG PERPDEMO/WRKLOTR IDEV 08/26/26 16:51:50 Page 26 + SQL_00026 A(1) 192D 529 + *RNF7031 SQL_00027 A(119) 193D + SQL_00028 A(20) 194D 530 + VARYING(2) + SQL_00029 P(15,4) 195D 531 + SQL_00030 A(10) 196D 532 + VARYING(2) + SQL_00031 A(10) 197D 533 + VARYING(2) + SQL_00032 B(4,0) 201D 546 551 + *RNF7031 SQL_00033 B(4,0) 202D + SQL_00034 U(10,0) 203D 543 + *RNF7031 SQL_00035 A(1) 204D + *RNF7031 SQL_00036 A(118) 205D + *RNF7031 SQL_00037 A(1) 206D + SQL_00038 B(4,0) 210D 617 + *RNF7031 SQL_00039 B(4,0) 211D + *RNF7031 SQL_00040 U(10,0) 212D + *RNF7031 SQL_00041 A(1) 213D + *RNF7031 SQL_00042 A(118) 214D + SQL_00043 A(3) 215D 607M + SQL_00044 A(25) 216D 608M + VARYING(2) + SQL_00045 A(20) 217D 609M + SQL_00046 P(15,4) 218D 610M + SQL_00047 A(10) 219D 611M + SQL_00048 A(10) 220D 612M + SQL_00049 A(10) 221D 613M + SQL_00050 B(4,0) 225D 658 + *RNF7031 SQL_00051 B(4,0) 226D + *RNF7031 SQL_00052 U(10,0) 227D + *RNF7031 SQL_00053 A(1) 228D + *RNF7031 SQL_00054 A(118) 229D + SQL_00055 P(15,4) 230D 648M + SQL_00056 A(10) 231D 649M + SQL_00057 A(10) 232D 650M + SQL_00058 A(10) 233D 651M + SQL_00059 A(3) 234D 652M + SQL_00060 A(25) 235D 653M + VARYING(2) + SQL_00061 A(20) 236D 654M + SQL_00062 B(4,0) 240D 681 + *RNF7031 SQL_00063 B(4,0) 241D + *RNF7031 SQL_00064 U(10,0) 242D + *RNF7031 SQL_00065 A(1) 243D + *RNF7031 SQL_00066 A(118) 244D + SQL_00067 A(3) 245D 675M + SQL_00068 A(25) 246D 676M + VARYING(2) + SQL_00069 A(20) 247D 677M + *RNF7031 SQLABC B(9,0) 96D + *RNF7031 SQLAID A(8) 94D + SQLCA DS(136) 92D 130 135 139 + 143 447 464 508 + 513 526 545 550 + 616 657 680 + SQLCABC I(10,0) 95D 96 + SQLCAID A(8) 93D 94 + 5770WDS V7R5M0 220415 RN IBM ILE RPG PERPDEMO/WRKLOTR IDEV 08/26/26 16:51:50 Page 27 + SQLCLSE CONST 138 149D + SQLCLSE_CALL PROTOTYPE 138D 549M + SQLCMIT CONST 142 150D + *RNF7031 SQLCMIT_CALL PROTOTYPE 142D + *RNF7031 SQLCOD B(9,0) 98D + SQLCODE I(10,0) 97D 98 453 517 + 518 535 535 619 + 620 660 661 683 + *RNF7031 SQLERL B(4,0) 100D + *RNF7031 SQLERM A(70) 102D + *RNF7031 SQLERP A(8) 104D + SQLERR A(24) 105D 106 107 108 + 109 110 111 112 + *RNF7031 SQLERRD(6) I(10,0) 112D + SQLERRMC A(70) 101D 102 + SQLERRML I(5,0) 99D 100 + SQLERRP A(8) 103D 104 + *RNF7031 SQLER1 B(9,0) 106D + *RNF7031 SQLER2 B(9,0) 107D + *RNF7031 SQLER3 B(9,0) 108D + *RNF7031 SQLER4 B(9,0) 109D + *RNF7031 SQLER5 B(9,0) 110D + SQLER6 B(9,0) 111D 445M 462M 504M + 524M 542M 614M 655M + 678M + SQLOPEN CONST 134 148D + SQLOPEN_CALL PROTOTYPE 134D 512M + SQLROUTE CONST 129 147D + SQLROUTE_CALL PROTOTYPE 129D 446M 463M 507M + 525M 544M 615M 656M + 679M + SQLSTATE A(5) 126D 127 621 684 + *RNF7031 SQLSTT A(5) 127D + *RNF7031 SQLWARN(11) A(1) 125D + *RNF7031 SQLWNA A(1) 124D + *RNF7031 SQLWN0 A(1) 114D + *RNF7031 SQLWN1 A(1) 115D + *RNF7031 SQLWN2 A(1) 116D + *RNF7031 SQLWN3 A(1) 117D + *RNF7031 SQLWN4 A(1) 118D + *RNF7031 SQLWN5 A(1) 119D + *RNF7031 SQLWN6 A(1) 120D + *RNF7031 SQLWN7 A(1) 121D + *RNF7031 SQLWN8 A(1) 122D + *RNF7031 SQLWN9 A(1) 123D + SQLWRN A(11) 113D 114 115 116 + 117 118 119 120 + 121 122 123 124 + 125 + SQTY P(15,4) 256M 567M 634 773 + SRECV A(10) 257M 568M 635 774 + STATUSDS DS(343) 53D 817 + PROGRAMNAME A(10) 54D 817 + VALIDEXPD N(1) 88D 737M 742M 745 + VALIDRECV N(1) 87D 726M 730M 732 + WRITEMSG PROTOTYPE 319M 388M 518M 585M + 620M 623M 661M 663M + 684M 686M 717M 722M + 5770WDS V7R5M0 220415 RN IBM ILE RPG PERPDEMO/WRKLOTR IDEV 08/26/26 16:51:50 Page 28 + 733M 746M 800 + Field References for subprocedure WRITEMSG + Field Attributes References (D=Defined M=Modified) + DATA A(256) 804D 805M 809 + TEXT A(256) 802D 805 810 + BASED(_QRNL_PST+) + VARYING(2) + Indicator References: + Indicator References (D=Defined M=Modified) + 03 250M 260M 266M 271M + 276M 281M 291M 298M + 322 377 + 05 251M 261M 267M 272M + 277M 282M 292M 299M + 381 + 06 252M 262M 268M 273M + 278M 283M 293M 300M + 386 + 12 253M 263M 269M 274M + 279M 284M 294M 301M + 322 377 601 639 + 710 + 30 324M 350M 360M 364M + 777 + 31 559M 561M 778 + 40 328M 331M 370M 373M + 703M 706M 798 + 41 762M 764M 799 + 50 563M 769 + 51 564M 770 + 60 351M 473M 475M 779 + LR 434M + * * * * * E N D O F C R O S S R E F E R E N C E * * * * * + 5770WDS V7R5M0 220415 RN IBM ILE RPG PERPDEMO/WRKLOTR IDEV 08/26/26 16:51:50 Page 29 + E x t e r n a l R e f e r e n c e s + Statically bound procedures: + Procedure References + Imported fields: + Field Attributes Defined + No references in the source. + Exported fields: + Field Attributes Defined + No references in the source. + * * * * * E N D O F E X T E R N A L R E F E R E N C E S * * * * * + 5770WDS V7R5M0 220415 RN IBM ILE RPG PERPDEMO/WRKLOTR IDEV 08/26/26 16:51:50 Page 30 + M e s s a g e S u m m a r y + Msg id Sv Number Message text + *RNF7031 00 58 The name or indicator is not referenced. + * * * * * E N D O F M E S S A G E S U M M A R Y * * * * * + 5770WDS V7R5M0 220415 RN IBM ILE RPG PERPDEMO/WRKLOTR IDEV 08/26/26 16:51:50 Page 31 + F i n a l S u m m a r y + Message Totals: + Information (00) . . . . . . . : 58 + Warning (10) . . . . . . . : 0 + Error (20) . . . . . . . : 0 + Severe Error (30+) . . . . . . : 0 + --------------------------------- ------- + Total . . . . . . . . . . . . . : 58 + Source Totals: + Records . . . . . . . . . . . . : 819 + Specifications . . . . . . . . : 651 + Data records . . . . . . . . . : 0 + Comments . . . . . . . . . . . : 147 + * * * * * E N D O F F I N A L S U M M A R Y * * * * * + Program WRKLOTR placed in library PERPDEMO. 00 highest severity. Created on 08/26/26 at 16:51:51. + * * * * * E N D O F C O M P I L A T I O N * * * * *