├── .gitignore ├── .ibmi.json ├── .vscode └── actions.json ├── LICENSE ├── QBNDSRC ├── Rules.mk └── SAMPLE.BNDDIR ├── QCBLSRC ├── .ibmi.json ├── PRO201.CBLLE ├── Rules.mk ├── verify.pgm.cblle ├── verifysql.sqlcblle └── verifysqlp.pgm.sqlcblle ├── QCLSRC ├── .ibmi.json ├── OPM.CLP ├── ORD100C.PGM.CLLE ├── ORD100C2.PGM.CLLE ├── ORD500C.PGM.CLLE ├── PAR201.CLLE └── Rules.mk ├── QCMDSRC ├── .ibmi.json ├── CRTORD.CMD ├── CVTSPLPDF.CMDSRC └── Rules.mk ├── QCPPSRC ├── PWD.CPP └── Rules.mk ├── QCSRC ├── PUTIFS.PGM.C ├── PUTIFSCHK.C └── Rules.mk ├── QDDSSRC ├── ART200D-Work_with_Article.DSPF ├── ART201D-Work_with_Article.DSPF ├── ART202D-Work_with_Article.DSPF ├── ART301D-Function_Select_an_article.DSPF ├── ARTICLE-Article_File.PF ├── ARTICLE1-Article_File.LF ├── ARTICLE2.LF ├── ARTIPRO1.LF ├── ARTIPROV.PF ├── COU200D.DSPF ├── COU301D.DSPF ├── COUNTR1.LF ├── COUNTRY.PF ├── CUS200D.DSPF ├── CUS301D.DSPF ├── CUSTOME1.LF ├── CUSTOME2.LF ├── CUSTOMER.PF ├── DETORD.PF ├── DETORD1.LF ├── FAM301D.DSPF ├── FAMILL1.LF ├── FAMILLY.PF ├── ORD100D.DSPF ├── ORD101D.DSPF ├── ORD200D.DSPF ├── ORD201D.DSPF ├── ORD202D.DSPF ├── ORD500O.PRTF ├── ORDER.PF ├── ORDER1.LF ├── ORDER2.LF ├── ORDER3.LF ├── PAR200D.DSPF ├── PARAMETER.PF ├── PRO200D.DSPF ├── PRO201D.DSPF ├── PRO202D.DSPF ├── PROVIDE1.LF ├── PROVIDER.PF └── Rules.mk ├── QDTASRC ├── LASTORDNO.DTAARA ├── Rules.mk └── STREAMDTA.DTAQ ├── QILESRC ├── PAR201.ILEPGM ├── PRO200.ILEPGM └── Rules.mk ├── QILESRVSRC ├── FARTICLE.ILESRVPGM ├── FPARAMETER.ILESRVPGM ├── LOG.ILESRVPGM └── Rules.mk ├── QMSGSRC ├── Rules.mk ├── SAMMSGF.MSGF └── SGSMSGF.MSGF ├── QPNLSRC ├── Rules.mk ├── SAMHELP-Help_Application_Sam.PNLGRPSRC ├── SAMMNU-Main_menu_application_SAMPLE.MENUSRC └── wstrig.wscstsrc ├── QPROTOSRC ├── .ibmi.json ├── APICALL-Prototypes_for_Ibm_API.RPGLEINC ├── ARTICLE.RPGLEINC ├── COUNTRY.RPGLEINC ├── CUSTOMER.RPGLEINC ├── FAMILLY.RPGLEINC ├── LOG_functions.RPGLEINC ├── PARAMETER.RPGLEINC ├── PROVIDER.RPGLEINC ├── README.md ├── VAT.RPGLEINC ├── XML.RPGLEINC ├── XSS.RPGLEINC └── txt.rpgleinc ├── QRPGLESRC ├── .ibmi.json ├── ART200-Work_with_article.PGM.SQLRPGLE ├── ART201-Work_with_article.PGM.RPGLE ├── ART202-Function_Article.PGM.RPGLE ├── ART300-Function_Article.RPGLE ├── ART301.SQLRPGLE ├── ART302.SQLRPGLE ├── COU300.RPGLE ├── COU301.RPGLE ├── CUS300.RPGLE ├── CUS301.SQLRPGLE ├── DAT001.RPGLE ├── DAT002.RPGLE ├── FAM300.RPGLE ├── FAM301.RPGLE ├── LOG100.PGM.RPGLE ├── LOG300.RPGLE ├── ORD100.PGM.RPGLE ├── ORD101.PGM.RPGLE ├── ORD200.PGM.SQLRPGLE ├── ORD201.PGM.SQLRPGLE ├── ORD202.PGM.RPGLE ├── ORD700.PGM.RPGLE ├── ORD900.PGM.RPGLE ├── ORD901.PGM.SQLRPGLE ├── PAR200.RPGLE ├── PAR300.RPGLE ├── PRO200.RPGLE ├── PRO202.SQLRPGLE ├── PRO300.RPGLE ├── Rules.mk ├── TXT001.RPGLE └── XML001.RPGLE ├── QRPGSRC ├── COU200.RPG └── Rules.mk ├── QSQLCPPSRC ├── ANZ_FILE.SQLCPP └── Rules.mk ├── QSQLCSRC ├── ANZ_FILE2.SQLC └── Rules.mk ├── QSQLSRC ├── .ibmi.json ├── ART801.SQLPRC ├── ARTIINF.TABLE ├── ARTLSTDAT.VIEW ├── CUSSEQ.SQLSEQ ├── ISOTODATE.SQLUDF ├── ISOTODATE4.SQLUDF ├── ORD701.SQLTRG ├── ORDERCUS.VIEW ├── Rules.mk └── readme.md ├── QSRVSRC ├── .ibmi.json ├── FARTICLE.BND ├── FCOUNTRY.BND ├── FCUSTOMER.BND ├── FFAMILLY.BND ├── FPROVIDER.BND ├── Rules.mk ├── TXT.BND └── XML.BND ├── QTRGSRC ├── .ibmi.json ├── ORD700A.SYSTRG ├── ORD700D.SYSTRG ├── ORD700U.SYSTRG └── Rules.mk ├── README.md ├── Rules.mk ├── common ├── Rules.mk └── SAMREF.PF ├── functionsVAT ├── .ibmi.json ├── Rules.mk ├── fvat.bnd ├── vat.rpgleinc ├── vat300.rpgle └── vatdef.pf ├── globalization ├── CHS │ ├── .ibmi.json │ ├── CHS.RPGLE │ └── Rules.mk ├── DEU │ ├── .ibmi.json │ ├── DEU.RPGLE │ ├── Däöü.RPGLE │ └── Rules.mk ├── HEB │ ├── .ibmi.json │ ├── Rules.mk │ └── heb.pgm.rpgle └── Rules.mk ├── includes └── included.clle └── iproj.json /.gitignore: -------------------------------------------------------------------------------- 1 | **/.deps 2 | **/.evfevent 3 | **/.logs 4 | 5 | **/.DS_Store 6 | .project 7 | .env 8 | -------------------------------------------------------------------------------- /.ibmi.json: -------------------------------------------------------------------------------- 1 | { 2 | "version": "0.0.1", 3 | "build": { 4 | "tgtCcsid": "37" 5 | } 6 | } -------------------------------------------------------------------------------- /.vscode/actions.json: -------------------------------------------------------------------------------- 1 | [ 2 | { 3 | "command": "err=*EVENTF lib1=&CURLIB makei build", 4 | "deployFirst": true, 5 | "environment": "pase", 6 | "extensions": [ 7 | "GLOBAL" 8 | ], 9 | "name": "bob build", 10 | "postDownload": [ 11 | ".logs/", 12 | ".evfevent/" 13 | ] 14 | }, 15 | { 16 | "command": "err=*EVENTF makei compile -f &BASENAME -e lib1=&CURLIB", 17 | "deployFirst": true, 18 | "environment": "pase", 19 | "extensions": [ 20 | "GLOBAL" 21 | ], 22 | "name": "bob compile", 23 | "postDownload": [ 24 | ".logs/", 25 | ".evfevent/" 26 | ] 27 | }, 28 | { 29 | "command": "err=*EVENTF lib1=&CURLIB ../ibmi-bob/bin/makei build", 30 | "deployFirst": true, 31 | "environment": "pase", 32 | "extensions": [ 33 | "GLOBAL" 34 | ], 35 | "name": "test bob build", 36 | "postDownload": [ 37 | ".logs/", 38 | ".evfevent/" 39 | ] 40 | }, 41 | { 42 | "command": "err=*EVENTF ../ibmi-bob/bin/makei compile -f &BASENAME -e lib1=&CURLIB", 43 | "deployFirst": true, 44 | "environment": "pase", 45 | "extensions": [ 46 | "GLOBAL" 47 | ], 48 | "name": "test bob compile", 49 | "postDownload": [ 50 | ".logs/", 51 | ".evfevent/" 52 | ] 53 | } 54 | ] -------------------------------------------------------------------------------- /QBNDSRC/Rules.mk: -------------------------------------------------------------------------------- 1 | SAMPLE.BNDDIR: SAMPLE.BNDDIR XML.SRVPGM TXT.SRVPGM FARTICLE.SRVPGM FCUSTOMER.SRVPGM FFAMILLY.SRVPGM FPARAMETER.SRVPGM FPROVIDER.SRVPGM LOG.SRVPGM 2 | -------------------------------------------------------------------------------- /QBNDSRC/SAMPLE.BNDDIR: -------------------------------------------------------------------------------- 1 | 2 | /* Have to delete the BNDDIR, or it will always be older than the source */ 3 | /* because the CRTBNDDIR will fail the second time and only the ADDBNDDIRE is executed */ 4 | !DLTOBJ OBJ(&O/&N) OBJTYPE(*BNDDIR) 5 | CRTBNDDIR BNDDIR(&O/&N) 6 | ADDBNDDIRE BNDDIR(&O/&N) + 7 | OBJ((*LIBL/XML *SRVPGM) (*LIBL/ORDER *SRVPGM) (*LIBL/TXT *SRVPGM) + 8 | (*LIBL/XSS *SRVPGM) (*LIBL/FARTICLE *SRVPGM) + 9 | (*LIBL/FCUSTOMER *SRVPGM) (*LIBL/FFAMILLY *SRVPGM) + 10 | (*LIBL/FPARAMETER *SRVPGM) (*LIBL/FPROVIDER *SRVPGM) + 11 | (*LIBL/FVAT *SRVPGM) (*LIBL/LOG *SRVPGM)) 12 | -------------------------------------------------------------------------------- /QCBLSRC/.ibmi.json: -------------------------------------------------------------------------------- 1 | { 2 | "version": "0.0.1", 3 | "build": 4 | { 5 | "tgtCcsid":"500" 6 | } 7 | } 8 | -------------------------------------------------------------------------------- /QCBLSRC/Rules.mk: -------------------------------------------------------------------------------- 1 | PRO201.MODULE: PRO201.CBLLE PRO201D.FILE 2 | VERIFY.PGM: verify.pgm.cblle 3 | VERIFYSQL.MODULE: verifysql.sqlcblle 4 | VERIFYSQLP.PGM: verifysqlp.pgm.sqlcblle 5 | -------------------------------------------------------------------------------- /QCBLSRC/verify.pgm.cblle: -------------------------------------------------------------------------------- 1 | PROCESS OPTIONS. 2 | IDENTIFICATION DIVISION. 3 | PROGRAM-ID. VERIFY. 4 | AUTHOR. PROGRAMMER NAME. 5 | INSTALLATION. TORONTO LABORATORY. 6 | DATE-WRITTEN. JANUARY 1, 1995. 7 | DATE-COMPILED. 8 | ENVIRONMENT DIVISION. 9 | CONFIGURATION SECTION. 10 | SOURCE-COMPUTER. IBM-I. 11 | OBJECT-COMPUTER. IBM-I. 12 | INPUT-OUTPUT SECTION. 13 | FILE-CONTROL. 14 | SELECT FILE1 ASSIGN TO PRINTER-QSYSPRT 15 | ORGANIZATION IS SEQUENTIAL. 16 | DATA DIVISION. 17 | FILE SECTION. 18 | FD FILE1 19 | RECORD CONTAINS 39 CHARACTERS. 20 | 01 REC-1 PIC X(39). 21 | WORKING-STORAGE SECTION. 22 | 01 PRINT-LINE PIC X(39) VALUE 23 | "ILE COBOL INSTALLATION IS VERIFIED.". 24 | 77 ERROR-COUNT PIC 9(3) VALUE ZEROES. 25 | 01 TEST-VARS. 26 | 05 A PIC 99 USAGE BINARY. 27 | 05 B PIC 99 USAGE COMP-3. 28 | 05 C PIC 999999 USAGE PACKED-DECIMAL. 29 | 05 D PIC S99 USAGE BINARY. 30 | PROCEDURE DIVISION. 31 | TEST1-INIT. 32 | MOVE 5 TO A. 33 | MOVE 2 TO B. 34 | MOVE -5 TO D. 35 | TEST-COMPUTE. 36 | COMPUTE C = A * B + D. 37 | IF A NOT = 5 OR B NOT = 2 OR D NOT = -5 OR C NOT = 5 38 | DISPLAY "COMPUTE FAILED FOR THE FOLLOWING:" 39 | DISPLAY "A = 5 =" A 40 | DISPLAY "B = 2 =" B 41 | DISPLAY "D = -5 =" D 42 | DISPLAY "Compute: 5 =" C 43 | ADD 1 TO ERROR-COUNT. 44 | TEST-ADD. 45 | ADD A B A B GIVING C. 46 | IF C NOT = 14 47 | DISPLAY "ADD FAILED FOR THE FOLLOWING:" 48 | DISPLAY "Add: 14 =" C 49 | ADD 1 TO ERROR-COUNT. 50 | TEST-SUBTRACT. 51 | SUBTRACT B D FROM A GIVING C. 52 | IF C NOT = 8 53 | DISPLAY "SUBTRACT FAILED FOR THE FOLLOWING:" 54 | DISPLAY "Subtract: 8 =" C 55 | ADD 1 TO ERROR-COUNT. 56 | TEST-DIVIDE. 57 | DIVIDE A BY B GIVING C. 58 | IF C NOT = 2 THEN 59 | DISPLAY "DIVIDE FAILED FOR THE FOLLOWING:" 60 | DISPLAY "Divide: 2 =" C 61 | ADD 1 TO ERROR-COUNT. 62 | FINISHED-NOW. 63 | IF ERROR-COUNT = 0 THEN 64 | OPEN OUTPUT FILE1 65 | WRITE REC-1 FROM PRINT-LINE 66 | CLOSE FILE1. 67 | STOP RUN. -------------------------------------------------------------------------------- /QCBLSRC/verifysql.sqlcblle: -------------------------------------------------------------------------------- 1 | PROCESS OPTIONS. 2 | IDENTIFICATION DIVISION. 3 | PROGRAM-ID. VERIFYSQL1. 4 | AUTHOR. PHIL MAWBY. 5 | INSTALLATION. TORONTO LABORATORY. 6 | DATE-WRITTEN. JANUARY 1, 1995. 7 | DATE-COMPILED. 8 | ENVIRONMENT DIVISION. 9 | CONFIGURATION SECTION. 10 | SOURCE-COMPUTER. IBM-I. 11 | OBJECT-COMPUTER. IBM-I. 12 | DATA DIVISION. 13 | WORKING-STORAGE SECTION. 14 | 01 PRINT-LINE PIC X(37) VALUE 15 | "ILE SQL COBOL PROGRAM SUCCESS.". 16 | 77 ERROR-COUNT PIC 9(3) VALUE ZEROES. 17 | 01 TEST-VARS. 18 | 05 A PIC S99. 19 | 05 B PIC S99. 20 | 05 C PIC S999999. 21 | 05 D PIC S99. 22 | * 23 | EXEC SQL 24 | INCLUDE SQLCA 25 | END-EXEC. 26 | * 27 | PROCEDURE DIVISION. 28 | TEST1-INIT. 29 | EXEC SQL SET :A = 5 END-EXEC. 30 | EXEC SQL SET :B = 2 END-EXEC. 31 | EXEC SQL SET :D = -5 END-EXEC. 32 | TEST-COMPUTE. 33 | COMPUTE C = A * B + D. 34 | IF A NOT = 5 OR B NOT = 2 OR D NOT = -5 OR C NOT = 5 35 | DISPLAY "COMPUTE FAILED FOR THE FOLLOWING:" 36 | DISPLAY "A = 5 =" A 37 | DISPLAY "B = 2 =" B 38 | DISPLAY "D = -5 =" D 39 | DISPLAY "Compute: 5 =" C 40 | ADD 1 TO ERROR-COUNT. 41 | TEST-ADD. 42 | ADD A B A B GIVING C. 43 | IF C NOT = 14 44 | DISPLAY "ADD FAILED FOR THE FOLLOWING:" 45 | DISPLAY "Add: 14 =" C 46 | ADD 1 TO ERROR-COUNT. 47 | TEST-SUBTRACT. 48 | SUBTRACT B D FROM A GIVING C. 49 | IF C NOT = 8 50 | DISPLAY "SUBTRACT FAILED FOR THE FOLLOWING:" 51 | DISPLAY "Subtract: 8 =" C 52 | ADD 1 TO ERROR-COUNT. 53 | TEST-DIVIDE. 54 | DIVIDE A BY B GIVING C. 55 | IF C NOT = 2 THEN 56 | DISPLAY "DIVIDE FAILED FOR THE FOLLOWING:" 57 | DISPLAY "Divide: 2 =" C 58 | ADD 1 TO ERROR-COUNT. 59 | FINISHED-NOW. 60 | IF ERROR-COUNT = 0 THEN 61 | DISPLAY PRINT-LINE 62 | ELSE 63 | DISPLAY "PROGRAM FAILED". 64 | STOP RUN. -------------------------------------------------------------------------------- /QCBLSRC/verifysqlp.pgm.sqlcblle: -------------------------------------------------------------------------------- 1 | PROCESS OPTIONS. 2 | IDENTIFICATION DIVISION. 3 | PROGRAM-ID. VERIFYSQL1. 4 | AUTHOR. PHIL MAWBY. 5 | INSTALLATION. TORONTO LABORATORY. 6 | DATE-WRITTEN. JANUARY 1, 1995. 7 | DATE-COMPILED. 8 | ENVIRONMENT DIVISION. 9 | CONFIGURATION SECTION. 10 | SOURCE-COMPUTER. IBM-I. 11 | OBJECT-COMPUTER. IBM-I. 12 | DATA DIVISION. 13 | WORKING-STORAGE SECTION. 14 | 01 PRINT-LINE PIC X(37) VALUE 15 | "ILE SQL COBOL PROGRAM SUCCESS.". 16 | 77 ERROR-COUNT PIC 9(3) VALUE ZEROES. 17 | 01 TEST-VARS. 18 | 05 A PIC S99. 19 | 05 B PIC S99. 20 | 05 C PIC S999999. 21 | 05 D PIC S99. 22 | * 23 | EXEC SQL 24 | INCLUDE SQLCA 25 | END-EXEC. 26 | * 27 | PROCEDURE DIVISION. 28 | TEST1-INIT. 29 | EXEC SQL SET :A = 5 END-EXEC. 30 | EXEC SQL SET :B = 2 END-EXEC. 31 | EXEC SQL SET :D = -5 END-EXEC. 32 | TEST-COMPUTE. 33 | COMPUTE C = A * B + D. 34 | IF A NOT = 5 OR B NOT = 2 OR D NOT = -5 OR C NOT = 5 35 | DISPLAY "COMPUTE FAILED FOR THE FOLLOWING:" 36 | DISPLAY "A = 5 =" A 37 | DISPLAY "B = 2 =" B 38 | DISPLAY "D = -5 =" D 39 | DISPLAY "Compute: 5 =" C 40 | ADD 1 TO ERROR-COUNT. 41 | TEST-ADD. 42 | ADD A B A B GIVING C. 43 | IF C NOT = 14 44 | DISPLAY "ADD FAILED FOR THE FOLLOWING:" 45 | DISPLAY "Add: 14 =" C 46 | ADD 1 TO ERROR-COUNT. 47 | TEST-SUBTRACT. 48 | SUBTRACT B D FROM A GIVING C. 49 | IF C NOT = 8 50 | DISPLAY "SUBTRACT FAILED FOR THE FOLLOWING:" 51 | DISPLAY "Subtract: 8 =" C 52 | ADD 1 TO ERROR-COUNT. 53 | TEST-DIVIDE. 54 | DIVIDE A BY B GIVING C. 55 | IF C NOT = 2 THEN 56 | DISPLAY "DIVIDE FAILED FOR THE FOLLOWING:" 57 | DISPLAY "Divide: 2 =" C 58 | ADD 1 TO ERROR-COUNT. 59 | FINISHED-NOW. 60 | IF ERROR-COUNT = 0 THEN 61 | DISPLAY PRINT-LINE 62 | ELSE 63 | DISPLAY "PROGRAM FAILED". 64 | STOP RUN. -------------------------------------------------------------------------------- /QCLSRC/.ibmi.json: -------------------------------------------------------------------------------- 1 | { 2 | "version": "0.0.1", 3 | "build": { 4 | "tgtCcsid": "500" 5 | } 6 | } 7 | -------------------------------------------------------------------------------- /QCLSRC/OPM.CLP: -------------------------------------------------------------------------------- 1 | /* this is OPM CL for completeness of example */ 2 | /* in practice you should just use ILE CL */ 3 | PGM PARM(&CUID) 4 | DCL VAR(&CUID) TYPE(*DEC) LEN(5 0) 5 | 6 | CALL ORD100C PARM(&CUID) 7 | ENDPGM -------------------------------------------------------------------------------- /QCLSRC/ORD100C.PGM.CLLE: -------------------------------------------------------------------------------- 1 | /*%%TEXT Create new order with parameter */ 2 | /*%%OBJECT-TYPE *PGM */ 3 | PGM PARM(&CUID) 4 | INCLUDE SRCSTMF('included.clle') 5 | DLTF FILE(QTEMP/DETORD) 6 | MONMSG MSGID(CPF0000) 7 | CRTDUPOBJ OBJ(DETORD) FROMLIB(*LIBL) OBJTYPE(*FILE) + 8 | TOLIB(QTEMP) NEWOBJ(DETORD) CST(*NO) + 9 | TRG(*NO) 10 | OVRDBF FILE(TMPDETORD) TOFILE(QTEMP/DETORD) 11 | CRTORD CUID(&CUID) 12 | ENDPGM 13 | -------------------------------------------------------------------------------- /QCLSRC/ORD100C2.PGM.CLLE: -------------------------------------------------------------------------------- 1 | 2 | PGM 3 | DLTF FILE(QTEMP/DETORD) 4 | MONMSG MSGID(CPF0000) 5 | CRTDUPOBJ OBJ(DETORD) FROMLIB(*LIBL) OBJTYPE(*FILE) + 6 | TOLIB(QTEMP) NEWOBJ(DETORD) CST(*NO) + 7 | TRG(*NO) 8 | OVRDBF FILE(TMPDETORD) TOFILE(QTEMP/DETORD) 9 | CALL PGM(ORD100) 10 | ENDPGM -------------------------------------------------------------------------------- /QCLSRC/ORD500C.PGM.CLLE: -------------------------------------------------------------------------------- 1 | PGM PARM(&ORD &PATH) 2 | DCL VAR(&ORD) TYPE(*CHAR) LEN(5) 3 | DCL VAR(&FILENAME) TYPE(*CHAR) LEN(50) 4 | DCL VAR(&PATH) TYPE(*CHAR) LEN(100) 5 | CHGVAR VAR(&FILENAME) VALUE('Custord' *CAT &ORD + 6 | *TCAT '.pdf') 7 | 8 | CVTSPLPDF FROMFILE(ORD500O) TOSTMF(&FILENAME) + 9 | TODIR(&PATH) SPLNBR(*LAST) + 10 | STMFOPT(*REPLACE) PAGESIZE(*A4 *PORTRAIT) + 11 | FONT(*COURIER 11) BOOKMARK(*NONE) 12 | ENDPGM -------------------------------------------------------------------------------- /QCLSRC/PAR201.CLLE: -------------------------------------------------------------------------------- 1 | DCL VAR(&PATH) TYPE(*CHAR) LEN(100) 2 | DCL VAR(&CODE) TYPE(*CHAR) LEN(10) VALUE('PATH') 3 | DCL VAR(&SUBCODE) TYPE(*CHAR) LEN(10) VALUE(' ') 4 | CALLPRC PRC(GETPARM2) PARM((&CODE *BYVAL) (&SUBCODE + 5 | *BYVAL)) RTNVAL(&PATH) 6 | CHGVAR VAR(&PATH) VALUE(&PATH *TCAT '*') 7 | WRKLNK OBJ(&PATH) 8 | -------------------------------------------------------------------------------- /QCLSRC/Rules.mk: -------------------------------------------------------------------------------- 1 | ORD100C.PGM: ORD100C.PGM.CLLE CRTORD.CMD included.clle 2 | ORD100C2.PGM: ORD100C2.PGM.CLLE 3 | ORD500C.PGM: ORD500C.PGM.CLLE CVTSPLPDF.CMD 4 | PAR201.MODULE: PAR201.CLLE 5 | OPM.PGM: OPM.CLP 6 | -------------------------------------------------------------------------------- /QCMDSRC/.ibmi.json: -------------------------------------------------------------------------------- 1 | { 2 | "version": "0.0.1", 3 | "build": { 4 | "tgtCcsid": "500" 5 | } 6 | } 7 | -------------------------------------------------------------------------------- /QCMDSRC/CRTORD.CMD: -------------------------------------------------------------------------------- 1 | CMD PROMPT('Create an Order') 2 | PARM KWD(CUID) TYPE(*DEC) LEN(5) DFT(0) + 3 | PROMPT('Customer Id.') 4 | -------------------------------------------------------------------------------- /QCMDSRC/CVTSPLPDF.CMDSRC: -------------------------------------------------------------------------------- 1 | CMD PROMPT('Convert Spool to PDF') 2 | 3 | PARM KWD(FROMFILE) TYPE(*NAME) LEN(10) MIN(1) + 4 | PROMPT('From spooled file name') 5 | 6 | PARM KWD(TOSTMF) TYPE(*NAME) LEN(64) MIN(1) PROMPT('To + 7 | stream file name') 8 | 9 | PARM KWD(TODIR) TYPE(*PNAME) LEN(256) MIN(1) PROMPT('To + 10 | directory') 11 | 12 | PARM KWD(JOB) TYPE(JOB) DFT(*) SNGVAL((*)) PROMPT('Job + 13 | name') 14 | JOB: QUAL TYPE(*NAME) LEN(10) MIN(1) 15 | QUAL TYPE(*NAME) LEN(10) MIN(1) PROMPT('User') 16 | QUAL TYPE(*CHAR) LEN(6) RANGE(000000 999999) MIN(1) + 17 | PROMPT('Number') 18 | 19 | PARM KWD(SPLNBR) TYPE(*DEC) LEN(4) DFT(*ONLY) RANGE(1 + 20 | 9999) SPCVAL((*LAST -2) (*ONLY -3)) + 21 | PROMPT('Spooled file number') 22 | 23 | PARM KWD(STMFOPT) TYPE(*CHAR) LEN(8) RSTD(*YES) + 24 | DFT(*NONE) VALUES(*NONE *REPLACE ) + 25 | PROMPT('Stream file option') 26 | 27 | PARM KWD(STMFCODPAG) TYPE(*DEC) LEN(5 0) DFT(1250) + 28 | RANGE(1 32767) SPCVAL((*PCASCII -1) (*STMF -2)) + 29 | PMTCTL(*PMTRQS) PROMPT('Stream file code page') 30 | 31 | PARM KWD(TITLE) TYPE(*CHAR) LEN(50) RSTD(*NO) + 32 | DFT(*NONE) SPCVAL((*NONE) (*STMFILE)) + 33 | PROMPT('Title for PDF') 34 | 35 | PARM KWD(PAGESIZE) TYPE(LIST3) DFT(*SPLF) + 36 | SNGVAL((*SPLF) (*CUSTOM)) CHOICE(*NONE) + 37 | PROMPT('Page size') 38 | LIST3: ELEM TYPE(*CHAR) LEN(7) RSTD(*YES) VALUES(*A4 *A5 + 39 | *LETTER *LEGAL *EXEC) PROMPT('Paper size') 40 | ELEM TYPE(*CHAR) LEN(10) RSTD(*YES) DFT(*LANDSCAPE) + 41 | VALUES(*LANDSCAPE *PORTRAIT) + 42 | PROMPT('Orientation') 43 | 44 | PARM KWD(CUSTOMPAGE) TYPE(LIST4) CHOICE(*NONE) + 45 | PMTCTL(CUSTOM) PROMPT('Custom page size') 46 | LIST4: ELEM TYPE(*DEC) LEN(6 3) DFT(210) RANGE(.001 999.999) + 47 | EXPR(*YES) PROMPT('Page width') 48 | ELEM TYPE(*DEC) LEN(6 3) DFT(297) RANGE(.001 999.999) + 49 | EXPR(*YES) PROMPT('Page length') 50 | ELEM TYPE(*CHAR) LEN(5) RSTD(*YES) DFT(*MM) + 51 | VALUES(*INCH *MM) EXPR(*YES) PROMPT('Unit of + 52 | measure') 53 | 54 | PARM KWD(FONT) TYPE(LIST5) DFT(*CONVERT) + 55 | SNGVAL((*CONVERT)) CHOICE(*NONE) PROMPT('Font') 56 | LIST5: ELEM TYPE(*CHAR) LEN(10) RSTD(*YES) SPCVAL((*COURIER) + 57 | (*COURIERB) (*COURIERO) (*COURIERBO) + 58 | (*HELVETICA) (*HELVB) (*HELVO) (*HELVBO) + 59 | (*TIMES) (*TIMESB) (*TIMESI) (*TIMESBI) + 60 | (*SYMBOL) (*DINGBATS)) EXPR(*YES) PROMPT('Face') 61 | ELEM TYPE(*DEC) LEN(2) DFT(*CALC) RANGE(4 36) + 62 | SPCVAL((*CALC -1)) EXPR(*YES) PROMPT('Size') 63 | 64 | PARM KWD(BOOKMARK) TYPE(*CHAR) LEN(7) RSTD(*YES) + 65 | DFT(*PAGNBR) VALUES(*PAGNBR *POS *KEY *NONE) + 66 | PROMPT('Type of PDF bookmarks') 67 | 68 | PARM KWD(BMARKPOS) TYPE(LIST1) PMTCTL(POS) PROMPT('PDF + 69 | bookmark string position') 70 | LIST1: ELEM TYPE(*DEC) LEN(3 0) DFT(1) RANGE(1 300) + 71 | PROMPT('Line number') 72 | ELEM TYPE(*DEC) LEN(3 0) DFT(1) RANGE(1 378) + 73 | PROMPT('Character position') 74 | ELEM TYPE(*DEC) LEN(3 0) DFT(1) RANGE(1 378) + 75 | PROMPT('Length') 76 | 77 | PARM KWD(BMARKKEY) TYPE(LIST2) PMTCTL(KEY) PROMPT('PDF + 78 | bookmark string key') 79 | LIST2: ELEM TYPE(*CHAR) LEN(378) DFT(' ') VARY(*YES *INT2) + 80 | PROMPT('Key string') 81 | ELEM TYPE(*DEC) LEN(3 0) DFT(1) RANGE(1 999) + 82 | PROMPT('Occurrence') 83 | ELEM TYPE(*DEC) LEN(3 0) DFT(0) RANGE(-378 378) + 84 | PROMPT('Offset') 85 | ELEM TYPE(*DEC) LEN(3 0) DFT(1) RANGE(1 378) + 86 | PROMPT('Length') 87 | 88 | CUSTOM: PMTCTL CTL(PAGESIZE) COND((*EQ *CUSTOM)) NBRTRUE(*EQ 1) 89 | 90 | POS: PMTCTL CTL(BOOKMARK) COND((*EQ *POS)) NBRTRUE(*EQ 1) 91 | 92 | KEY: PMTCTL CTL(BOOKMARK) COND((*EQ *KEY)) NBRTRUE(*EQ 1) 93 | 94 | -------------------------------------------------------------------------------- /QCMDSRC/Rules.mk: -------------------------------------------------------------------------------- 1 | CRTORD.CMD: CRTORD.CMD ORD100.PGM 2 | CRTORD.CMD: PGM=ORD100 3 | CVTSPLPDF.CMD: CVTSPLPDF.CMDSRC 4 | -------------------------------------------------------------------------------- /QCPPSRC/PWD.CPP: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | 9 | #define argcpy(a,b) memcpy((a),(b),sizeof(a)-1); (a)[sizeof(a)-1]=0x00 10 | 11 | 12 | int main(int argc, 13 | char * argv[]) 14 | { 15 | /* 16 | int signal; 17 | char szSignal[10+1]; 18 | char szPidFile[100+1]; 19 | 20 | argcpy(szPidFile, argv[1]); 21 | argcpy(szSignal, argv[2]); 22 | 23 | { 24 | int i=sizeof(szPidFile)-2; 25 | while (szPidFile[i] == ' ') 26 | szPidFile[i--]=0x00; 27 | } 28 | */ 29 | { 30 | char curDir[1024]; 31 | char buf[10]; 32 | char *p=getcwd(curDir, sizeof(curDir)); 33 | if (p == NULL) 34 | fprintf(stderr, "getcwd() failed\n"); 35 | fprintf(stdout, "%s\n", p); 36 | 37 | gets(buf); 38 | return 0; 39 | } 40 | } 41 | -------------------------------------------------------------------------------- /QCPPSRC/Rules.mk: -------------------------------------------------------------------------------- 1 | PWD.MODULE: PWD.CPP 2 | PWD.PGM: private ACTGRP := *CALLER 3 | PWD.PGM: PWD.MODULE 4 | -------------------------------------------------------------------------------- /QCSRC/PUTIFS.PGM.C: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | #include 7 | 8 | #define argcpy(a,b) { \ 9 | int i=sizeof(a)-1; \ 10 | (a)[i]=0x00; \ 11 | strncpy((a),(b),i); \ 12 | do { \ 13 | (a)[i--]=0x00; \ 14 | } while ((a)[i] == ' '); \ 15 | } 16 | #define isBlank(v) ((v) == ' ' || (v) == '\t') 17 | #if defined(__OS400_TGTVRM__) || defined(__ILEC400__) 18 | # define isSep(v) (isBlank(v) || (v) == 0x25 || (v) == '\r' || (v) == '\n' || (v) == 0x00) 19 | #else 20 | # define isSep(v) (isBlank(v) || (v) == '\r' || (v) == '\n' || (v) == 0x00) 21 | #endif 22 | #define trimEOF(l) { int len=strlen(l)-1; while (isSep((l)[len])) (l)[len--]=0x00; } 23 | 24 | 25 | 26 | static const char clError[]="Error message ID = "; 27 | int main(int argc, 28 | char * argv[]) 29 | { 30 | int rc = 0; 31 | char lib[10+1]; 32 | char file[10+1]; 33 | char mbr[10+1]; 34 | 35 | argcpy(lib, argv[1]); 36 | argcpy(file, argv[2]); 37 | argcpy(mbr, argv[3]); 38 | 39 | { 40 | FILE *fd; 41 | char fileName[100]; 42 | char line[1024]; 43 | char lastCmd[1024]; 44 | 45 | sprintf(fileName, "/QSYS.LIB/%s.LIB/%s.FILE/%s.MBR", lib, file, mbr); 46 | if ((fd = fopen(fileName, "r")) == NULL) 47 | { 48 | fprintf(stderr, "open(%s, 'r') failed, errno = %d\n", fileName, errno); 49 | return 1; 50 | } 51 | 52 | while (!feof(fd)) 53 | { 54 | if (fgets(line, sizeof(line), fd) == NULL) 55 | break; 56 | 57 | trimEOF(line); 58 | 59 | if (line[0] == 0x00) 60 | continue; 61 | 62 | if (isdigit(line[0]) && line[3] == ' ') 63 | { 64 | if (memcmp(line+4, "bytes transferred in ", 21) == 0) 65 | continue; 66 | 67 | if (line[0] == '4' || line[0] == '5') 68 | { 69 | if (memcmp(lastCmd, "QUOTE RCMD MKDIR DIR(", 21) == 0) 70 | continue; 71 | 72 | rc = atoi(line); 73 | fprintf(stderr, "Error %d in command: %s\n", rc, lastCmd); 74 | } 75 | 76 | } else if (memcmp(line, clError, sizeof(clError)-1) == 0) { 77 | if (memcpy(lastCmd, "SYSCMD CRTSAVF FILE(QTEMP/PUTIFSSAVF)", 37) == 0) 78 | continue; 79 | 80 | rc = atoi(line + sizeof(clError)); 81 | fprintf(stderr, "Error %s in command: %s\n", line + sizeof(clError), lastCmd); 82 | 83 | } else if (line[0] == '>') { 84 | strcpy(lastCmd, line + 2); 85 | } 86 | } 87 | 88 | if (rc > 0) 89 | { 90 | fprintf(stderr, "-- Dump of %s ----------------\n", file); 91 | fseek(fd, 0, SEEK_SET); 92 | while (!feof(fd)) 93 | { 94 | if (fgets(line, sizeof(line), fd) == NULL) 95 | break; 96 | trimEOF(line); 97 | 98 | if (line[0] == 0x00) 99 | continue; 100 | 101 | fprintf(stderr, "%s\n", line); 102 | } 103 | fprintf(stderr, "-- End of %s ----------------\n", file); 104 | fflush(stderr); 105 | gets(line); 106 | } 107 | 108 | fclose(fd); 109 | } 110 | return rc; 111 | } 112 | 113 | -------------------------------------------------------------------------------- /QCSRC/PUTIFSCHK.C: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | #include 7 | 8 | #define argcpy(a,b) { \ 9 | int i=sizeof(a)-1; \ 10 | (a)[i]=0x00; \ 11 | strncpy((a),(b),i); \ 12 | do { \ 13 | (a)[i--]=0x00; \ 14 | } while ((a)[i] == ' '); \ 15 | } 16 | #define isBlank(v) ((v) == ' ' || (v) == '\t') 17 | #if defined(__OS400_TGTVRM__) || defined(__ILEC400__) 18 | # define isSep(v) (isBlank(v) || (v) == 0x25 || (v) == '\r' || (v) == '\n' || (v) == 0x00) 19 | #else 20 | # define isSep(v) (isBlank(v) || (v) == '\r' || (v) == '\n' || (v) == 0x00) 21 | #endif 22 | #define trimEOF(l) { int len=strlen(l)-1; while (isSep((l)[len])) (l)[len--]=0x00; } 23 | 24 | 25 | 26 | static const char clError[]="Error message ID = "; 27 | int main(int argc, 28 | char * argv[]) 29 | { 30 | int rc = 0; 31 | char lib[10+1]; 32 | char file[10+1]; 33 | char mbr[10+1]; 34 | 35 | argcpy(lib, argv[1]); 36 | argcpy(file, argv[2]); 37 | argcpy(mbr, argv[3]); 38 | 39 | { 40 | FILE *fd; 41 | char fileName[100]; 42 | char line[1024]; 43 | char lastCmd[1024]; 44 | 45 | sprintf(fileName, "/QSYS.LIB/%s.LIB/%s.FILE/%s.MBR", lib, file, mbr); 46 | if ((fd = fopen(fileName, "r")) == NULL) 47 | { 48 | fprintf(stderr, "open(%s, 'r') failed, errno = %d\n", fileName, errno); 49 | return 1; 50 | } 51 | 52 | while (!feof(fd)) 53 | { 54 | if (fgets(line, sizeof(line), fd) == NULL) 55 | break; 56 | 57 | trimEOF(line); 58 | 59 | if (line[0] == 0x00) 60 | continue; 61 | 62 | if (isdigit(line[0]) && line[3] == ' ') 63 | { 64 | if (memcmp(line+4, "bytes transferred in ", 21) == 0) 65 | continue; 66 | 67 | if (line[0] == '4' || line[0] == '5') 68 | { 69 | if (memcmp(lastCmd, "QUOTE RCMD MKDIR DIR(", 21) == 0) 70 | continue; 71 | 72 | rc = atoi(line); 73 | fprintf(stderr, "Error %d in command: %s\n", rc, lastCmd); 74 | } 75 | 76 | } else if (memcmp(line, clError, sizeof(clError)-1) == 0) { 77 | if (memcpy(lastCmd, "SYSCMD CRTSAVF FILE(QTEMP/PUTIFSSAVF)", 37) == 0) 78 | continue; 79 | 80 | rc = atoi(line + sizeof(clError)); 81 | fprintf(stderr, "Error %s in command: %s\n", line + sizeof(clError), lastCmd); 82 | 83 | } else if (line[0] == '>') { 84 | strcpy(lastCmd, line + 2); 85 | } 86 | } 87 | 88 | if (rc > 0) 89 | { 90 | fprintf(stderr, "-- Dump of %s ----------------\n", file); 91 | fseek(fd, 0, SEEK_SET); 92 | while (!feof(fd)) 93 | { 94 | if (fgets(line, sizeof(line), fd) == NULL) 95 | break; 96 | trimEOF(line); 97 | 98 | if (line[0] == 0x00) 99 | continue; 100 | 101 | fprintf(stderr, "%s\n", line); 102 | } 103 | fprintf(stderr, "-- End of %s ----------------\n", file); 104 | fflush(stderr); 105 | gets(line); 106 | } 107 | 108 | fclose(fd); 109 | } 110 | return rc; 111 | } 112 | 113 | -------------------------------------------------------------------------------- /QCSRC/Rules.mk: -------------------------------------------------------------------------------- 1 | PUTIFSCHK.MODULE: private OPTIMIZE = 40 2 | PUTIFSCHK.MODULE: private INLINE = *ON *AUTO *NOLIMIT *NOLIMIT *YES 3 | PUTIFSCHK.MODULE: private DBGVIEW = *NONE 4 | PUTIFSCHK.MODULE:PUTIFSCHK.C 5 | PUTIFSCHK.PGM: private ACTGRP := *CALLER 6 | PUTIFSCHK.PGM:PUTIFSCHK.MODULE 7 | PUTIFS.PGM: PUTIFS.PGM.C 8 | 9 | 10 | -------------------------------------------------------------------------------- /QDDSSRC/ART201D-Work_with_Article.DSPF: -------------------------------------------------------------------------------- 1 | A*%%TS SD 20161201 100328 VTAQUIN REL-V7R1M0 5770-WDS 2 | A*%%EC 3 | A*COMMENT 4 | A DSPSIZ(24 80 *DS3) 5 | A INDARA 6 | A CA03(03) 7 | A CA12(12) 8 | A PRINT 9 | A ERRSFL 10 | A R SFL01 SFL 11 | A*%%TS SD 20161025 170547 VTAQUIN REL-V7R1M0 5770-WDS 12 | A 33 SFLNXTCHG 13 | A OPT01 2Y 0B 7 3 14 | A 34 DSPATR(RI) 15 | A 34 DSPATR(PC) 16 | A EDTCDE(Z) 17 | A APPRID R O 7 7REFFLD(FARPR/APPRID *LIBL/ARTIPROV) 18 | A PROVNM R O 7 13REFFLD(FPROV/PROVNM *LIBL/PROVIDER) 19 | A APPRICE R O 7 44REFFLD(FARPR/APPRICE *LIBL/ARTIPROV) 20 | A EDTCDE(2) 21 | A APREF R O 7 57REFFLD(FARPR/APREF *LIBL/ARTIPROV) 22 | A R CTL01 SFLCTL(SFL01) 23 | A*%%TS SD 20161201 100051 VTAQUIN REL-V7R1M0 5770-WDS 24 | A CA05(05) 25 | A OVERLAY 26 | A 31 SFLDSP 27 | A 32 SFLDSPCTL 28 | A 30 SFLCLR 29 | A 80 SFLEND(*MORE) 30 | A SFLSIZ(0015) 31 | A SFLPAG(0014) 32 | A 35 SFLMSG('Invalid Option' 35) 33 | A RRB01 4S 0H SFLRCDNBR 34 | A 1 2'ART201-1' 35 | A COLOR(BLU) 36 | A 3 4'Type options, press Enter.' 37 | A COLOR(BLU) 38 | A 6 2'Opt' 39 | A DSPATR(HI) 40 | A 1 27'Work with Article Providers' 41 | A DSPATR(HI) 42 | A 1 68DATE 43 | A EDTCDE(Y) 44 | A 2 68TIME 45 | A 4 7'2=Edit' 46 | A COLOR(BLU) 47 | A APARID R O 2 4REFFLD(APARID ARTIPROV) 48 | A ARDESC R O 2 11REFFLD(ARDESC ARTICLE) 49 | A 6 7'Provider' 50 | A DSPATR(HI) 51 | A 6 44'Unit Price' 52 | A DSPATR(HI) 53 | A 6 57'Reference' 54 | A DSPATR(HI) 55 | A R KEY01 56 | A*%%TS SD 20161201 100051 VTAQUIN REL-V7R1M0 5770-WDS 57 | A 23 3'F3=Exit' 58 | A COLOR(BLU) 59 | A 23 34'F12=Cancel' 60 | A COLOR(BLU) 61 | A 23 17'F5=Refresh' 62 | A COLOR(BLU) 63 | A R FMT02 64 | A*%%TS SD 20161201 100328 VTAQUIN REL-V7R1M0 5770-WDS 65 | A CF04(04 'Prompt') 66 | A 1 2'ART201-2' 67 | A COLOR(BLU) 68 | A 3 4'Type choices, press Enter.' 69 | A COLOR(BLU) 70 | A 23 3'F3=Exit' 71 | A COLOR(BLU) 72 | A 23 19'F12=Cancel' 73 | A COLOR(BLU) 74 | A 1 32'ARTIPROV definition' 75 | A DSPATR(HI) 76 | A 5 4'Article . . . . . . . :' 77 | A ARDESC R O 6 29REFFLD(ARDESC ARTICLE) 78 | A 9 4'Unit Price . . . . . .' 79 | A 10 4'Provider Reference . . .' 80 | A 7 4'Provider' 81 | A 7 13'.' 82 | A 7 15'.' 83 | A 7 17'.' 84 | A 7 19'.' 85 | A 7 21'.' 86 | A 7 23'.' 87 | A 7 25'.' 88 | A 7 27':' 89 | A APARID R O 5 29REFFLD(APARID ARTIPROV) 90 | A APPRICE R B 9 29REFFLD(FARPR/APPRICE *LIBL/ARTIPROV) 91 | A EDTCDE(2) 92 | A APREF R B 10 29REFFLD(FARPR/APREF *LIBL/ARTIPROV) 93 | A APPRID R O 7 29REFFLD(FARPR/APPRID *LIBL/ARTIPROV) 94 | A PROVNM R O 8 29REFFLD(FPROV/PROVNM *LIBL/PROVIDER) 95 | -------------------------------------------------------------------------------- /QDDSSRC/ART202D-Work_with_Article.DSPF: -------------------------------------------------------------------------------- 1 | A*%%TS SD 20161201 121434 VTAQUIN REL-V7R1M0 5770-WDS 2 | A*%%EC 3 | A DSPSIZ(24 80 *DS3) 4 | A INDARA 5 | A CA03(03) 6 | A CA12(12) 7 | A PRINT 8 | A ERRSFL 9 | A R SFL01 SFL 10 | A*%%TS SD 20161104 143857 VTAQUIN REL-V7R1M0 5770-WDS 11 | A 33 SFLNXTCHG 12 | A OPT01 2Y 0B 7 3 13 | A 34 DSPATR(RI) 14 | A 34 DSPATR(PC) 15 | A EDTCDE(Z) 16 | A APREF R O 7 64REFFLD(FARPR/APREF *LIBL/ARTIPROV) 17 | A APARID R O 7 6REFFLD(APARID ARTIPROV) 18 | A ARDESC R O 7 13REFFLD(ARDESC ARTICLE) 19 | A APPRICE R H REFFLD(FARPR/APPRICE *LIBL/ARTIPROV) 20 | A R CTL01 SFLCTL(SFL01) 21 | A*%%TS SD 20161104 143857 VTAQUIN REL-V7R1M0 5770-WDS 22 | A SFLSIZ(0015) 23 | A SFLPAG(0014) 24 | A OVERLAY 25 | A 31 SFLDSP 26 | A 32 SFLDSPCTL 27 | A 30 SFLCLR 28 | A 80 SFLEND(*MORE) 29 | A 35 SFLMSG('Invalid Option' 35) 30 | A RRB01 4S 0H SFLRCDNBR 31 | A 1 2'ART202-1' 32 | A COLOR(BLU) 33 | A 3 4'Type options, press Enter.' 34 | A COLOR(BLU) 35 | A 6 2'Opt' 36 | A DSPATR(HI) 37 | A 1 27'Work with Article Providers' 38 | A DSPATR(HI) 39 | A 1 68DATE 40 | A EDTCDE(Y) 41 | A 2 68TIME 42 | A 4 7'2=Edit' 43 | A COLOR(BLU) 44 | A 6 64'Reference' 45 | A DSPATR(HI) 46 | A APPRID R O 2 4REFFLD(FARPR/APPRID *LIBL/ARTIPROV) 47 | A PROVNM R O 2 10REFFLD(FPROV/PROVNM *LIBL/PROVIDER) 48 | A 6 6'Article' 49 | A DSPATR(HI) 50 | A R KEY01 51 | A 23 3'F3=Exit' 52 | A COLOR(BLU) 53 | A 23 19'F12=Cancel' 54 | A COLOR(BLU) 55 | 56 | A R FMT02 57 | A*%%TS SD 20161025 170547 VTAQUIN REL-V7R1M0 5770-WDS 58 | A CF04(04 'Prompt') 59 | A 1 2'ART202-2' 60 | A COLOR(BLU) 61 | A 3 4'Type choices, press Enter.' 62 | A COLOR(BLU) 63 | A 23 3'F3=Exit' 64 | A COLOR(BLU) 65 | A 23 19'F12=Cancel' 66 | A COLOR(BLU) 67 | A 1 32'ARTIPROV definition' 68 | A DSPATR(HI) 69 | A 5 4'Article . . . . . . . :' 70 | A ARDESC R O 6 29REFFLD(ARDESC ARTICLE) 71 | A 9 4'Unit Price . . . . . .' 72 | A 10 4'Provider Reference . . .' 73 | A 7 4'Provider' 74 | A 7 13'.' 75 | A 7 15'.' 76 | A 7 17'.' 77 | A 7 19'.' 78 | A 7 21'.' 79 | A 7 23'.' 80 | A 7 25'.' 81 | A 7 27':' 82 | A APARID R O 5 29REFFLD(APARID ARTIPROV) 83 | A APPRICE R B 9 29REFFLD(FARPR/APPRICE *LIBL/ARTIPROV) 84 | A EDTCDE(2) 85 | A APREF R B 10 29REFFLD(FARPR/APREF *LIBL/ARTIPROV) 86 | A APPRID R O 7 29REFFLD(FARPR/APPRID *LIBL/ARTIPROV) 87 | A PROVNM R O 8 29REFFLD(FPROV/PROVNM *LIBL/PROVIDER) 88 | -------------------------------------------------------------------------------- /QDDSSRC/ART301D-Function_Select_an_article.DSPF: -------------------------------------------------------------------------------- 1 | A*%%TS SD 20161129 155718 VTAQUIN REL-V7R1M0 5770-WDS 2 | A*%%EC 3 | A DSPSIZ(24 80 *DS3) 4 | A REF(*LIBL/ARTICLE) 5 | A INDARA 6 | A PRINT 7 | A ERRSFL 8 | A CA03(03) 9 | A CA12(12) 10 | A R SFL01 SFL 11 | A*%%TS SD 20161129 105751 VTAQUIN REL-V7R1M0 5770-WDS 12 | A 33 SFLNXTCHG 13 | A OPT01 1Y 0B 8 3 14 | A 34 DSPATR(RI) 15 | A 34 DSPATR(PC) 16 | A EDTCDE(Z) 17 | A ARID R O 8 5REFFLD(ARID ARTICLE) 18 | A ARDESC R O 8 12REFFLD(FARTI/ARDESC *LIBL/ARTICLE) 19 | A ARTIFA R O 8 63REFFLD(FARTI/ARTIFA *LIBL/ARTICLE) 20 | A ARSALEPR R O 8 67REFFLD(FARTI/ARSALEPR *LIBL/ARTICLE) 21 | A R CTL01 SFLCTL(SFL01) 22 | A*%%TS SD 20161129 155718 VTAQUIN REL-V7R1M0 5770-WDS 23 | A SFLSIZ(0015) 24 | A SFLPAG(0014) 25 | A N80 PAGEDOWN(25 'dynamic subfile') 26 | A CF04(04) 27 | A OVERLAY 28 | A 31 SFLDSP 29 | A 32 SFLDSPCTL 30 | A 30 SFLCLR 31 | A 80 SFLEND(*MORE) 32 | A 35 SFLMSG('INVALID OPTION' 35) 33 | A 36 SFLMSG('ONLY ONE SELECTION' 36) 34 | A RRB01 4S 0H SFLRCDNBR 35 | A 1 32'Select an Article' 36 | A DSPATR(HI) 37 | A 4 3'Make a selection. Press Enter' 38 | A COLOR(BLU) 39 | A 5 5'1=Select' 40 | A COLOR(BLU) 41 | A 7 2'Opt' 42 | A DSPATR(HI) 43 | A 7 6'Code' 44 | A DSPATR(HI) 45 | A 1 2'ART301' 46 | A COLOR(BLU) 47 | A 2 3'Desc contains . . . :' 48 | A 3 3'Family . . . . . . . :' 49 | A SRCHDESC 10A B 2 27 50 | A 7 12'Description' 51 | A DSPATR(HI) 52 | A 7 63'Fam' 53 | A DSPATR(HI) 54 | A 7 68'Price' 55 | A DSPATR(HI) 56 | A SRCHFAM R B 3 27REFFLD(FARTI/ARTIFA *LIBL/ARTICLE) 57 | A 1 70DATE 58 | A EDTCDE(Y) 59 | A COLOR(BLU) 60 | A 2 70TIME 61 | A COLOR(BLU) 62 | A FAMDESC 20A O 3 33 63 | A R KEY01 64 | A*%%TS SD 20161129 155218 VTAQUIN REL-V7R1M0 5770-WDS 65 | A OVERLAY 66 | A 23 2'F3=Exit' 67 | A COLOR(BLU) 68 | A 23 29'F12=Cancel' 69 | A COLOR(BLU) 70 | A 23 14'F4=Prompt' 71 | A COLOR(BLU) 72 | -------------------------------------------------------------------------------- /QDDSSRC/ARTICLE-Article_File.PF: -------------------------------------------------------------------------------- 1 | REF(SAMREF) 2 | R FARTI 3 | ARID R 4 | ARDESC R 5 | ARSALEPR R REFFLD(UNITPRICE) 6 | TEXT('REF SALE PRICE') 7 | COLHDG('REF' 'SALE' 'PRICE') 8 | EDTCDE(2) 9 | ARWHSPR R REFFLD(UNITPRICE) 10 | TEXT('STOCK PRICE') 11 | COLHDG('STOCK' 'PRICE') 12 | EDTCDE(2) 13 | ARTIFA R REFFLD(FAID) 14 | ARSTOCK R REFFLD(QUANTITY) 15 | TEXT('STOCK') 16 | COLHDG('STOCK') 17 | EDTCDE(2) 18 | ARMINQTY R REFFLD(QUANTITY) 19 | TEXT('MINIMUM STOCK') 20 | COLHDG('MINIMUM' 'STOCK') 21 | EDTCDE(2) 22 | ARCUSQTY R REFFLD(QUANTITY) 23 | TEXT('CUSTOMER ORDER QUANTITY') 24 | COLHDG('CUSTOMER' 'ORDER' 'QTY') 25 | ARPURQTY R REFFLD(QUANTITY) 26 | TEXT('PURCHASE ORDER QUANTITY') 27 | COLHDG('PRUCHASE' 'ORDER' 'QTY') 28 | EDTCDE(2) 29 | ARVATCD R REFFLD(VATCODE) 30 | ARCREA L TEXT('CREATION DATE') 31 | COLHDG('CREAETION' 'DATE') 32 | ARMOD Z TEXT('LAST MODIFICATION') 33 | COLHDG('LAST' 'MODIFICATION') 34 | ARMODID 11 TEXT('LAS MOD BY') 35 | COLHDG('LAST' 'MODIF.' 'BY') 36 | ARDEL R REFFLD(DLCODE) 37 | -------------------------------------------------------------------------------- /QDDSSRC/ARTICLE1-Article_File.LF: -------------------------------------------------------------------------------- 1 | UNIQUE 2 | R FARTI PFILE(ARTICLE) 3 | K ARID 4 | -------------------------------------------------------------------------------- /QDDSSRC/ARTICLE2.LF: -------------------------------------------------------------------------------- 1 | R FARTI PFILE(ARTICLE) 2 | K ARDESC 3 | K ARID 4 | -------------------------------------------------------------------------------- /QDDSSRC/ARTIPRO1.LF: -------------------------------------------------------------------------------- 1 | UNIQUE 2 | R FARPR PFILE(ARTIPROV) 3 | K APARID 4 | K APPRID 5 | -------------------------------------------------------------------------------- /QDDSSRC/ARTIPROV.PF: -------------------------------------------------------------------------------- 1 | UNIQUE 2 | REF(SAMREF) 3 | R FARPR 4 | APARID R REFFLD(ARID) 5 | APPRID R REFFLD(PRID) 6 | APPRICE R REFFLD(UNITPRICE) 7 | COLHDG('BUY PRICE') 8 | APREF 10 TEXT('PROVIDER REFERENCE') 9 | APCREA L TEXT('CREATION DATE') 10 | COLHDG('CREAETION' 'DATE') 11 | APMOD Z TEXT('LAST MODIFICATION') 12 | COLHDG('LAST' 'MODIFICATION') 13 | APMODID 10 TEXT('LAS MOD BY') 14 | COLHDG('LAST' 'MODIF.' 'BY') 15 | APDEL R REFFLD(DLCODE) 16 | K APPRID 17 | K APARID 18 | -------------------------------------------------------------------------------- /QDDSSRC/COU200D.DSPF: -------------------------------------------------------------------------------- 1 | A*%%TS SD 20161104 162149 VTAQUIN REL-V7R1M0 5770-WDS 2 | A*%%EC 3 | A DSPSIZ(24 80 *DS3) 4 | A INDARA 5 | A CA03(03) 6 | A CA12(12) 7 | A PRINT 8 | A ERRSFL 9 | A R SFL01 SFL 10 | A*%%TS SD 20161104 162149 VTAQUIN REL-V7R1M0 5770-WDS 11 | A 33 SFLNXTCHG 12 | A OPT01 2Y 0B 7 3 13 | A 34 DSPATR(RI) 14 | A 34 DSPATR(PC) 15 | A EDTCDE(Z) 16 | A COID R O 7 7REFFLD(FCOUN/COID *LIBL/COUNTRY) 17 | A COUNTR R O 7 10REFFLD(FCOUN/COUNTR *LIBL/COUNTRY) 18 | A COISO R O 7 41REFFLD(FCOUN/COISO *LIBL/COUNTRY) 19 | A R CTL01 SFLCTL(SFL01) 20 | A*%%TS SD 20161104 162149 VTAQUIN REL-V7R1M0 5770-WDS 21 | A SFLSIZ(0015) 22 | A SFLPAG(0014) 23 | A N80 PAGEDOWN(25 'dynamic subfile') 24 | A OVERLAY 25 | A 31 SFLDSP 26 | A 32 SFLDSPCTL 27 | A 30 SFLCLR 28 | A 80 SFLEND(*MORE) 29 | A 35 SFLMSG('Invalid Option' 35) 30 | A RRB01 4S 0H SFLRCDNBR 31 | A 1 2'COU200 ' 32 | A COLOR(BLU) 33 | A 3 4'Type options, press Enter.' 34 | A COLOR(BLU) 35 | A 4 6'2=Edit' 36 | A COLOR(BLU) 37 | A 6 3'Opt' 38 | A DSPATR(HI) 39 | A 1 31'Work with Countries' 40 | A DSPATR(HI) 41 | A 1 66DATE 42 | A EDTCDE(Y) 43 | A 2 66TIME 44 | A R KEY01 45 | A 23 3'F3=Exit' 46 | A COLOR(BLU) 47 | A 23 19'F12=Cancel' 48 | A COLOR(BLU) 49 | A R FMT02 50 | A*%%TS SD 20161104 162149 VTAQUIN REL-V7R1M0 5770-WDS 51 | A 1 2'COU200 ' 52 | A COLOR(BLU) 53 | A 3 4'Type choices, press Enter.' 54 | A COLOR(BLU) 55 | A 23 3'F3=Exit' 56 | A COLOR(BLU) 57 | A 23 19'F12=Cancel' 58 | A COLOR(BLU) 59 | A 6 4'Country Name . . .' 60 | A 5 4'Country Code . . :' 61 | A 7 4'Iso Code (3) . . .' 62 | A 1 34'Edit a country' 63 | A DSPATR(HI) 64 | A 1 66DATE 65 | A EDTCDE(Y) 66 | A 2 66TIME 67 | A COID R O 5 24REFFLD(FCOUN/COID *LIBL/COUNTRY) 68 | A COUNTR R B 6 24REFFLD(FCOUN/COUNTR *LIBL/COUNTRY) 69 | A CHECK(LC) 70 | A COISO R B 7 24REFFLD(FCOUN/COISO *LIBL/COUNTRY) 71 | -------------------------------------------------------------------------------- /QDDSSRC/COU301D.DSPF: -------------------------------------------------------------------------------- 1 | A*%%TS SD 20161025 135749 VTAQUIN REL-V7R1M0 5770-WDS 2 | A*%%EC 3 | A DSPSIZ(24 80 *DS3) 4 | A INDARA 5 | A PRINT 6 | A ERRSFL 7 | A CA03(03) 8 | A CA12(12) 9 | A R DUMMY 10 | A KEEP 11 | A ASSUME 12 | A OVERLAY 13 | A PUTOVR 14 | A FLD001 1 O 23 79 15 | A R SFL01 SFL 16 | A*%%TS SD 20161025 121722 VTAQUIN REL-V7R1M0 5770-WDS 17 | A 33 SFLNXTCHG 18 | A OPT01 1Y 0B 6 3 19 | A 34 DSPATR(RI) 20 | A 34 DSPATR(PC) 21 | A EDTCDE(Z) 22 | A COID R O 6 5REFFLD(COID COUNTRY) 23 | A COUNTR R O 6 9REFFLD(COUNTR COUNTRY) 24 | A R CTL01 SFLCTL(SFL01) 25 | A*%%TS SD 20161025 135749 VTAQUIN REL-V7R1M0 5770-WDS 26 | A SFLSIZ(0011) 27 | A SFLPAG(0010) 28 | A WINDOW(KEY01) 29 | A CF08(08) 30 | A N80 PAGEDOWN(25 'dynamic subfile') 31 | A OVERLAY 32 | A 31 SFLDSP 33 | A 32 SFLDSPCTL 34 | A 30 SFLCLR 35 | A 80 SFLEND(*MORE) 36 | A 35 SFLMSG('INVALID OPTION' 35) 37 | A 36 SFLMSG('ONLY ONE SELECTION' 36) 38 | A RRB01 4S 0H SFLRCDNBR 39 | A 1 22'Select a Country Code' 40 | A DSPATR(HI) 41 | A 2 2'Make a selection. Press Enter' 42 | A COLOR(BLU) 43 | A 3 3'1=Select' 44 | A COLOR(BLU) 45 | A 4 2'Opt' 46 | A DSPATR(HI) 47 | A OPTC1 1Y 0B 5 3EDTCDE(Z) 48 | A 41 ERRMSG('Invalid option' 41) 49 | A 42 ERRMSG('Position to not available w- 50 | A ith selection pending' 42) 51 | A 3 19'8=Position to' 52 | A COLOR(BLU) 53 | A 4 6'Code' 54 | A DSPATR(HI) 55 | A 4 13'Description' 56 | A DSPATR(HI) 57 | A POSCOD R B 5 5REFFLD(COID COUNTRY) 58 | A 40 DSPATR(ND) 59 | A 40 DSPATR(PR) 60 | A 1 1'COU301' 61 | A COLOR(BLU) 62 | A POSDES R B 5 9REFFLD(COUNTR COUNTRY) 63 | A N40 DSPATR(ND) 64 | A N40 DSPATR(PR) 65 | A CHECK(LC) 66 | A R KEY01 67 | A*%%TS SD 20161025 135749 VTAQUIN REL-V7R1M0 5770-WDS 68 | A OVERLAY 69 | A WINDOW(4 25 18 42) 70 | A 17 2'F3=Exit' 71 | A COLOR(BLU) 72 | A 40 17 14'F8=By code' 73 | A COLOR(BLU) 74 | A N40 17 14'F8=By desc.' 75 | A COLOR(BLU) 76 | A 17 27'F12=Cancel' 77 | A COLOR(BLU) 78 | -------------------------------------------------------------------------------- /QDDSSRC/COUNTR1.LF: -------------------------------------------------------------------------------- 1 | R FCOUN PFILE(COUNTRY) 2 | K COUNTR 3 | -------------------------------------------------------------------------------- /QDDSSRC/COUNTRY.PF: -------------------------------------------------------------------------------- 1 | UNIQUE 2 | REF(SAMREF) 3 | R FCOUN 4 | COID R 5 | COUNTR R 6 | COISO 3 7 | COISO5 3 8 | COISO1 3 9 | K COID 10 | -------------------------------------------------------------------------------- /QDDSSRC/CUS301D.DSPF: -------------------------------------------------------------------------------- 1 | A*%%TS SD 20161128 161956 VTAQUIN REL-V7R1M0 5770-WDS 2 | A*%%EC 3 | A DSPSIZ(24 80 *DS3) 4 | A REF(*LIBL/CUSTOMER) 5 | A INDARA 6 | A PRINT 7 | A ERRSFL 8 | A CA03(03) 9 | A CA12(12) 10 | A R SFL01 SFL 11 | A*%%TS SD 20161128 161956 VTAQUIN REL-V7R1M0 5770-WDS 12 | A 33 SFLNXTCHG 13 | A OPT01 1Y 0B 8 3 14 | A 34 DSPATR(RI) 15 | A 34 DSPATR(PC) 16 | A EDTCDE(Z) 17 | A CUID R O 8 5REFFLD(FCUST/CUID *LIBL/CUSTOMER) 18 | A CUSTNM R O 8 11REFFLD(FCUST/CUSTNM *LIBL/CUSTOMER) 19 | A CUCITY R O 8 42REFFLD(FCUST/CUCITY *LIBL/CUSTOMER) 20 | A CUCOUN R O 8 73REFFLD(FCUST/CUCOUN *LIBL/CUSTOMER) 21 | A R CTL01 SFLCTL(SFL01) 22 | A*%%TS SD 20161128 161956 VTAQUIN REL-V7R1M0 5770-WDS 23 | A CF08(08) 24 | A N80 PAGEDOWN(25 'dynamic subfile') 25 | A OVERLAY 26 | A 31 SFLDSP 27 | A 32 SFLDSPCTL 28 | A 30 SFLCLR 29 | A 80 SFLEND(*MORE) 30 | A SFLSIZ(0015) 31 | A SFLPAG(0014) 32 | A 35 SFLMSG('INVALID OPTION' 35) 33 | A 36 SFLMSG('ONLY ONE SELECTION' 36) 34 | A RRB01 4S 0H SFLRCDNBR 35 | A 1 32'Select a Customer' 36 | A DSPATR(HI) 37 | A 4 3'Make a selection. Press Enter' 38 | A COLOR(BLU) 39 | A 5 5'1=Select' 40 | A COLOR(BLU) 41 | A 7 2'Opt' 42 | A DSPATR(HI) 43 | A 7 6'Code' 44 | A DSPATR(HI) 45 | A 1 2'CUS301' 46 | A COLOR(BLU) 47 | A 7 11'Name' 48 | A DSPATR(HI) 49 | A 7 42'City' 50 | A DSPATR(HI) 51 | A 2 3'Name contains . . . :' 52 | A 3 3'City contains . . . :' 53 | A SRCHNAME 10 B 2 27 54 | A SRCHCITY 10 B 3 27 55 | A R KEY01 56 | A*%%TS SD 20161128 161956 VTAQUIN REL-V7R1M0 5770-WDS 57 | A OVERLAY 58 | A 23 2'F3=Exit' 59 | A COLOR(BLU) 60 | A 40 23 14'F8=By code' 61 | A COLOR(BLU) 62 | A 23 14'F12=Cancel' 63 | A COLOR(BLU) 64 | -------------------------------------------------------------------------------- /QDDSSRC/CUSTOME1.LF: -------------------------------------------------------------------------------- 1 | UNIQUE 2 | R FCUST PFILE(CUSTOMER) 3 | K CUID 4 | -------------------------------------------------------------------------------- /QDDSSRC/CUSTOME2.LF: -------------------------------------------------------------------------------- 1 | R FCUST PFILE(CUSTOMER) 2 | K CUSTNM 3 | K CUID 4 | -------------------------------------------------------------------------------- /QDDSSRC/CUSTOMER.PF: -------------------------------------------------------------------------------- 1 | REF(SAMREF) 2 | R FCUST 3 | CUID R 4 | CUSTNM R 5 | CUPHONE R REFFLD(PHONE) 6 | CUVAT R REFFLD(VATNUM) 7 | CUMAIL R REFFLD(EMAIL) 8 | CULINE1 R REFFLD(ADRLINE) 9 | CULINE2 R REFFLD(ADRLINE) 10 | CULINE3 R REFFLD(ADRLINE) 11 | CUZIP R REFFLD(ZIPCOD) 12 | CUCITY R REFFLD(CITY) 13 | CUCOUN R REFFLD(COID) 14 | CULIMCRE 9 2 TEXT('LIMIT CREDIT') 15 | COLHDG('LIMIT' 'CREDIT') 16 | CUCREDIT 9 2 TEXT('CREDIT') 17 | COLHDG('CREDIT') 18 | CULASTORD 8 0 TEXT('Last Order Date') 19 | COLHDG('Last' 'Order' 'Date') 20 | CUCREA L TEXT('CREATION DATE') 21 | COLHDG('CREAETION' 'DATE') 22 | CUMOD Z TEXT('LAST MODIFICATION') 23 | COLHDG('LAST' 'MODIFICATION') 24 | CUMODID 10 TEXT('LAS MOD BY') 25 | COLHDG('LAST' 'MODIF.' 'BY') 26 | CUDEL R REFFLD(DLCODE) 27 | -------------------------------------------------------------------------------- /QDDSSRC/DETORD.PF: -------------------------------------------------------------------------------- 1 | REF(SAMREF) 2 | R FDETO 3 | ODORID R REFFLD(ORID) 4 | ODYEAR R REFFLD(YEAR) 5 | ODLINE R 6 | ODARID R REFFLD(ARID) 7 | ODQTY R TEXT('ORDERED QUANTITY') 8 | COLHDG('ORDER' 'QUANTITY') 9 | REFFLD(QUANTITY) 10 | ODQTYLIV R TEXT('DELIVERED QUANTITY') 11 | COLHDG('DELIV' 'QUANTITY') 12 | REFFLD(QUANTITY) 13 | ODPRICE R REFFLD(UNITPRICE) 14 | ODTOT R REFFLD(TOTPRICE) 15 | ODTOTVAT R REFFLD(TOTPRICE) 16 | TEXT('TOTAL LINE WITH VAT') 17 | COLHDG('TOTAL LINE' 'WITH VAT') 18 | K ODLINE 19 | K ODORID 20 | K ODYEAR 21 | -------------------------------------------------------------------------------- /QDDSSRC/DETORD1.LF: -------------------------------------------------------------------------------- 1 | UNIQUE 2 | R FDETO PFILE(DETORD) 3 | K ODORID 4 | K ODLINE 5 | -------------------------------------------------------------------------------- /QDDSSRC/FAM301D.DSPF: -------------------------------------------------------------------------------- 1 | A*%%TS SD 20161025 132922 VTAQUIN REL-V7R1M0 5770-WDS 2 | A*%%EC 3 | A DSPSIZ(24 80 *DS3) 4 | A INDARA 5 | A PRINT 6 | A ERRSFL 7 | A CA03(03) 8 | A CA12(12) 9 | A R DUMMY 10 | A KEEP 11 | A ASSUME 12 | A OVERLAY 13 | A PUTOVR 14 | A FLD001 1 O 23 79 15 | A R SFL01 SFL 16 | A*%%TS SD 20161025 121722 VTAQUIN REL-V7R1M0 5770-WDS 17 | A 33 SFLNXTCHG 18 | A OPT01 1Y 0B 6 3 19 | A 34 DSPATR(RI) 20 | A 34 DSPATR(PC) 21 | A EDTCDE(Z) 22 | A FAID R O 6 5REFFLD(FAID FAMILLY) 23 | A FADESC R O 6 9REFFLD(FFAMI/FADESC *LIBL/FAMILLY) 24 | A R CTL01 SFLCTL(SFL01) 25 | A*%%TS SD 20161025 132922 VTAQUIN REL-V7R1M0 5770-WDS 26 | A SFLSIZ(0011) 27 | A SFLPAG(0010) 28 | A WINDOW(KEY01) 29 | A CF08(08) 30 | A N80 PAGEDOWN(25 'dynamic subfile') 31 | A OVERLAY 32 | A 31 SFLDSP 33 | A 32 SFLDSPCTL 34 | A 30 SFLCLR 35 | A 80 SFLEND(*MORE) 36 | A 35 SFLMSG('INVALID OPTION' 35) 37 | A 36 SFLMSG('ONLY ONE SELECTION' 36) 38 | A RRB01 4S 0H SFLRCDNBR 39 | A 1 22'Select a Familly Code' 40 | A DSPATR(HI) 41 | A 2 2'Make a selection. Press Enter' 42 | A COLOR(BLU) 43 | A 3 3'1=Select' 44 | A COLOR(BLU) 45 | A 4 2'Opt' 46 | A DSPATR(HI) 47 | A OPTC1 1Y 0B 5 3EDTCDE(Z) 48 | A 41 ERRMSG('Invalid option' 41) 49 | A 42 ERRMSG('Position to not available w- 50 | A ith selection pending' 42) 51 | A 3 19'8=Position to' 52 | A COLOR(BLU) 53 | A 4 6'Code' 54 | A DSPATR(HI) 55 | A 4 13'Description' 56 | A DSPATR(HI) 57 | A POSCOD R B 5 5REFFLD(FAID FAMILLY) 58 | A 40 DSPATR(ND) 59 | A 40 DSPATR(PR) 60 | A 1 1'FAM301' 61 | A COLOR(BLU) 62 | A POSDES R B 5 9REFFLD(FADESC FAMILLY) 63 | A N40 DSPATR(ND) 64 | A N40 DSPATR(PR) 65 | A CHECK(LC) 66 | A R KEY01 67 | A*%%TS SD 20161025 132115 VTAQUIN REL-V7R1M0 5770-WDS 68 | A OVERLAY 69 | A WINDOW(4 13 18 62) 70 | A 17 2'F3=Exit' 71 | A COLOR(BLU) 72 | A 40 17 14'F8=By code' 73 | A COLOR(BLU) 74 | A N40 17 14'F8=By desc.' 75 | A COLOR(BLU) 76 | A 17 27'F12=Cancel' 77 | A COLOR(BLU) 78 | -------------------------------------------------------------------------------- /QDDSSRC/FAMILL1.LF: -------------------------------------------------------------------------------- 1 | R FFAMI PFILE(FAMILLY) 2 | K FADESC 3 | -------------------------------------------------------------------------------- /QDDSSRC/FAMILLY.PF: -------------------------------------------------------------------------------- 1 | REF(SAMREF) 2 | UNIQUE 3 | R FFAMI 4 | FAID R 5 | FADESC R 6 | FAVATCD R REFFLD(VATCODE) 7 | TEXT('DFT VAT CODE') 8 | COLHDG('DFT' 'VAT' 'CD') 9 | FACREA L TEXT('CREATION DATE') 10 | COLHDG('CREAETION' 'DATE') 11 | FAMOD Z TEXT('LAST MODIFICATION') 12 | COLHDG('LAST' 'MODIFICATION') 13 | FAMODID 10 TEXT('LAS MOD BY') 14 | COLHDG('LAST' 'MODIF.' 'BY') 15 | FADEL R REFFLD(DLCODE) 16 | K FAID 17 | -------------------------------------------------------------------------------- /QDDSSRC/ORD200D.DSPF: -------------------------------------------------------------------------------- 1 | A*%%TS SD 20161221 160454 VTAQUIN REL-V7R1M0 5770-WDS 2 | A*%%EC 3 | A DSPSIZ(24 80 *DS3) 4 | A INDARA 5 | A CA03(03) 6 | A CA12(12) 7 | A PRINT 8 | A ERRSFL 9 | A R SFL01 SFL 10 | A*%%TS SD 20161027 180427 VTAQUIN REL-V7R1M0 5770-WDS 11 | A 33 SFLNXTCHG 12 | A OPT01 2Y 0B 7 3 13 | A 34 DSPATR(RI) 14 | A 34 DSPATR(PC) 15 | A EDTCDE(Z) 16 | A ORID R O 7 6REFFLD(FORDE/ORID *LIBL/ORDER) 17 | A EDTCDE(2) 18 | A ORYEAR R O 7 14REFFLD(FORDE/ORYEAR *LIBL/ORDER) 19 | A EDTCDE(Z) 20 | A DATORD L O 7 20DATFMT(*JOB) 21 | A DATLIV L O 7 46DATFMT(*JOB) 22 | A MAPVAL(('1940-01-01' *BLANK)) 23 | A DATCLO L O 7 57DATFMT(*JOB) 24 | A MAPVAL(('1940-01-01' *BLANK)) 25 | A SUMORD 11Y 2O 7 31EDTCDE(2) 26 | A R CTL01 SFLCTL(SFL01) 27 | A*%%TS SD 20161221 160454 VTAQUIN REL-V7R1M0 5770-WDS 28 | A SFLSIZ(0015) 29 | A SFLPAG(0014) 30 | A CF06(06 'Create') 31 | A CA05(05 'Refresh') 32 | A OVERLAY 33 | A 31 SFLDSP 34 | A 32 SFLDSPCTL 35 | A 30 SFLCLR 36 | A 80 SFLEND(*MORE) 37 | A 35 SFLMSG('Invalid Option' 35) 38 | A 36 SFLMSG('Closed order can not be edi- 39 | A ted or deleted' 36) 40 | A 37 SFLMSG('Order whith deliveries can - 41 | A not be deleted' 37) 42 | A RRB01 4S 0H SFLRCDNBR 43 | A 1 2'ORD200-1' 44 | A COLOR(BLU) 45 | A 3 4'Type options, press Enter.' 46 | A COLOR(BLU) 47 | A 6 2'Opt' 48 | A DSPATR(HI) 49 | A 1 27'Work with Customer Orders' 50 | A DSPATR(HI) 51 | A 1 68DATE 52 | A EDTCDE(Y) 53 | A COLOR(BLU) 54 | A 2 68TIME 55 | A COLOR(BLU) 56 | A 4 7'2=Edit' 57 | A COLOR(BLU) 58 | A 4 30'5=Display' 59 | A COLOR(BLU) 60 | A 4 18'4=Delete' 61 | A COLOR(BLU) 62 | A 4 43'6=Print ' 63 | A COLOR(BLU) 64 | A 4 56'7=Close' 65 | A COLOR(BLU) 66 | A CUID R O 2 4REFFLD(FCUST/CUID *LIBL/CUSTOMER) 67 | A CUSTNM R O 2 10REFFLD(FCUST/CUSTNM *LIBL/CUSTOMER) 68 | A 6 8'Order' 69 | A DSPATR(HI) 70 | A 6 14'Year' 71 | A DSPATR(HI) 72 | A 6 20'Creation' 73 | A DSPATR(HI) 74 | A 6 46'Delivery' 75 | A DSPATR(HI) 76 | A 6 57'Close' 77 | A DSPATR(HI) 78 | A 6 37'Value' 79 | A DSPATR(HI) 80 | A 4 68'8=Deliver' 81 | A COLOR(BLU) 82 | A R KEY01 83 | A*%%TS SD 20161129 163917 VTAQUIN REL-V7R1M0 5770-WDS 84 | A 23 3'F3=Exit' 85 | A COLOR(BLU) 86 | A 23 32'F12=Cancel' 87 | A COLOR(BLU) 88 | A 23 16'F6=Create' 89 | A COLOR(BLU) 90 | -------------------------------------------------------------------------------- /QDDSSRC/ORD201D.DSPF: -------------------------------------------------------------------------------- 1 | A*%%TS SD 20161221 160008 VTAQUIN REL-V7R1M0 5770-WDS 2 | A*%%EC 3 | A DSPSIZ(24 80 *DS3) 4 | A INDARA 5 | A CA03(03) 6 | A CA12(12) 7 | A PRINT 8 | A ERRSFL 9 | A R SFL01 SFL 10 | A*%%TS SD 20161221 160008 VTAQUIN REL-V7R1M0 5770-WDS 11 | A 33 SFLNXTCHG 12 | A OPT01 2Y 0B 7 3 13 | A 34 DSPATR(RI) 14 | A 34 DSPATR(PC) 15 | A EDTCDE(Z) 16 | A ORID R O 7 6REFFLD(FORDE/ORID *LIBL/ORDER) 17 | A EDTCDE(2) 18 | A ORYEAR R O 7 14REFFLD(FORDE/ORYEAR *LIBL/ORDER) 19 | A EDTCDE(Z) 20 | A DATCLO L O 7 57DATFMT(*JOB) 21 | A MAPVAL(('1940-01-01' *BLANK)) 22 | A SUMORD 11Y 2O 7 31EDTCDE(2) 23 | A CUID R O 8 6REFFLD(FCUST/CUID *LIBL/CUSTOMER) 24 | A CUSTNM R O 8 12REFFLD(FCUST/CUSTNM *LIBL/CUSTOMER) 25 | A DATORD L O 7 19DATFMT(*JOB) 26 | A DATLIV L O 7 46DATFMT(*JOB) 27 | A MAPVAL(('1940-01-01' *BLANK)) 28 | A R CTL01 SFLCTL(SFL01) 29 | A*%%TS SD 20161221 160008 VTAQUIN REL-V7R1M0 5770-WDS 30 | A SFLSIZ(0015) 31 | A SFLPAG(0007) 32 | A N80 PAGEDOWN(25 'dynamic subfile') 33 | A CF06(06 'Create') 34 | A CA05(05 'Refresh') 35 | A OVERLAY 36 | A 31 SFLDSP 37 | A 32 SFLDSPCTL 38 | A 30 SFLCLR 39 | A 80 SFLEND(*MORE) 40 | A SFLDROP(CF11) 41 | A 35 SFLMSG('Invalid Option' 35) 42 | A 36 SFLMSG('Closed order can not be edi- 43 | A ted or deleted' 36) 44 | A 37 SFLMSG('Order whith deliveries can - 45 | A not be deleted' 37) 46 | A RRB01 4S 0H SFLRCDNBR 47 | A 1 2'ORD200-1' 48 | A COLOR(BLU) 49 | A 3 4'Type options, press Enter.' 50 | A COLOR(BLU) 51 | A 6 2'Opt' 52 | A DSPATR(HI) 53 | A 1 27'Work with Customer Orders' 54 | A DSPATR(HI) 55 | A 1 68DATE 56 | A EDTCDE(Y) 57 | A 2 68TIME 58 | A 4 7'2=Edit' 59 | A COLOR(BLU) 60 | A 4 30'5=Display' 61 | A COLOR(BLU) 62 | A 4 18'4=Delete' 63 | A COLOR(BLU) 64 | A 4 43'6=Print' 65 | A COLOR(BLU) 66 | A 4 56'7=Close' 67 | A COLOR(BLU) 68 | A 6 8'Order' 69 | A DSPATR(HI) 70 | A 6 14'Year' 71 | A DSPATR(HI) 72 | A 6 19'Creation' 73 | A DSPATR(HI) 74 | A 6 46'Delivery' 75 | A DSPATR(HI) 76 | A 6 57'Close' 77 | A DSPATR(HI) 78 | A 6 37'Value' 79 | A DSPATR(HI) 80 | A 4 68'8=Deliver' 81 | A COLOR(BLU) 82 | A R KEY01 83 | A*%%TS SD 20161209 163300 VTAQUIN REL-V7R1M0 5770-WDS 84 | A 23 3'F3=Exit' 85 | A COLOR(BLU) 86 | A 23 55'F12=Cancel' 87 | A COLOR(BLU) 88 | A 23 42'F11=Detail' 89 | A COLOR(BLU) 90 | A 23 14'F5=Refresh' 91 | A COLOR(BLU) 92 | A 23 28'F6=Create' 93 | A COLOR(BLU) 94 | -------------------------------------------------------------------------------- /QDDSSRC/ORD202D.DSPF: -------------------------------------------------------------------------------- 1 | A*%%TS SD 20161201 092910 VTAQUIN REL-V7R1M0 5770-WDS 2 | A*%%EC 3 | A DSPSIZ(24 80 *DS3) 4 | A INDARA 5 | A CA03(03) 6 | A CA12(12) 7 | A PRINT 8 | A ERRSFL 9 | A R SFL01 SFL 10 | A*%%TS SD 20161201 092045 VTAQUIN REL-V7R1M0 5770-WDS 11 | A 33 SFLNXTCHG 12 | A ODLINE R O 8 2REFFLD(FDETO/ODLINE *LIBL/DETORD) 13 | A EDTCDE(Z) 14 | A ODARID R O 8 8REFFLD(FDETO/ODARID *LIBL/DETORD) 15 | A ODQTY R O 8 15REFFLD(FDETO/ODQTY *LIBL/DETORD) 16 | A EDTCDE(2) 17 | A ODQTYLIV R O 8 22REFFLD(FDETO/ODQTYLIV *LIBL/DETORD) 18 | A EDTCDE(2) 19 | A ODPRICE R O 8 40REFFLD(FDETO/ODPRICE *LIBL/DETORD) 20 | A EDTCDE(2) 21 | A ODTOT R O 8 50REFFLD(FDETO/ODTOT *LIBL/DETORD) 22 | A EDTCDE(2) 23 | A ODTOTVAT R O 8 63REFFLD(FDETO/ODTOTVAT *LIBL/DETORD) 24 | A EDTCDE(2) 25 | A ARDESC R O 9 8REFFLD(FARTI/ARDESC *LIBL/ARTICLE) 26 | A R CTL01 SFLCTL(SFL01) 27 | A*%%TS SD 20161201 092850 VTAQUIN REL-V7R1M0 5770-WDS 28 | A CF06(06 'Create') 29 | A CA05(05 'Refresh') 30 | A OVERLAY 31 | A 31 SFLDSP 32 | A 32 SFLDSPCTL 33 | A 30 SFLCLR 34 | A 80 SFLEND(*MORE) 35 | A SFLDROP(CF11) 36 | A SFLSIZ(0007) 37 | A SFLPAG(0006) 38 | A 35 SFLMSG('Invalid Option' 35) 39 | A RRB01 4S 0H SFLRCDNBR 40 | A 1 2'ORD202-1' 41 | A COLOR(BLU) 42 | A 1 27'Display a Customer Orders' 43 | A DSPATR(HI) 44 | A 1 68DATE 45 | A EDTCDE(Y) 46 | A 2 68TIME 47 | A 2 2'Order . . .' 48 | A ORID R O 2 15REFFLD(FORDE/ORID *LIBL/ORDER) 49 | A ORYEAR R O 2 22REFFLD(FORDE/ORYEAR *LIBL/ORDER) 50 | A 3 2'Customer .' 51 | A CUID R O 3 15REFFLD(FCUST/CUID *LIBL/CUSTOMER) 52 | A CUSTNM R O 3 22REFFLD(FCUST/CUSTNM *LIBL/CUSTOMER) 53 | A DATORD L O 4 15DATFMT(*DMY) 54 | A DATLIV L O 5 15DATFMT(*DMY) 55 | A MAPVAL(('01/01/40' *BLANK)) 56 | A DATCLO L O 6 15DATFMT(*DMY) 57 | A MAPVAL(('01/01/40' *BLANK)) 58 | A 4 2'Création .' 59 | A 5 2'Delivery .' 60 | A 6 2'Close . . .' 61 | A 7 2'Line' 62 | A DSPATR(HI) 63 | A 7 7' Art.' 64 | A DSPATR(HI) 65 | A 7 15'Qty ' 66 | A DSPATR(HI) 67 | A 7 22'Deliver' 68 | A DSPATR(HI) 69 | A 7 41'Un.Price' 70 | A DSPATR(HI) 71 | A 7 54'Total' 72 | A DSPATR(HI) 73 | A 7 65'With VAT' 74 | A DSPATR(HI) 75 | A R KEY01 76 | A*%%TS SD 20161201 092910 VTAQUIN REL-V7R1M0 5770-WDS 77 | A 23 3'F3=Exit' 78 | A COLOR(BLU) 79 | A 23 32'F12=Cancel' 80 | A COLOR(BLU) 81 | A 23 17'F11=Detail' 82 | A COLOR(BLU) 83 | A TOT R O 22 50REFFLD(FDETO/ODTOT *LIBL/DETORD) 84 | A DSPATR(HI) 85 | A TOTVAT R O 22 63REFFLD(FDETO/ODTOTVAT *LIBL/DETORD) 86 | A DSPATR(HI) 87 | A 21 50'============ ============' 88 | A DSPATR(HI) 89 | -------------------------------------------------------------------------------- /QDDSSRC/ORDER.PF: -------------------------------------------------------------------------------- 1 | REF(SAMREF) 2 | R FORDE 3 | ORID R 4 | ORYEAR R REFFLD(YEAR) 5 | ORCUID R REFFLD(CUID) 6 | ORDATE 8 0 TEXT('ORDER DATE') 7 | COLHDG('ORDER' 'DATE') 8 | ORDATDEL 8 0 TEXT('DELIVERY DATE') 9 | COLHDG('DELIVERY' 'DATE') 10 | ORDATCLO 8 0 TEXT('CLOSE DATE') 11 | COLHDG('CLOSE' 'DATE') 12 | -------------------------------------------------------------------------------- /QDDSSRC/ORDER1.LF: -------------------------------------------------------------------------------- 1 | UNIQUE 2 | R FORDE PFILE(ORDER) 3 | K ORID 4 | -------------------------------------------------------------------------------- /QDDSSRC/ORDER2.LF: -------------------------------------------------------------------------------- 1 | R FORDE PFILE(ORDER) 2 | K ORCUID 3 | K ORID 4 | -------------------------------------------------------------------------------- /QDDSSRC/ORDER3.LF: -------------------------------------------------------------------------------- 1 | R FORDE PFILE(ORDER) 2 | K ORDATE 3 | K ORID 4 | -------------------------------------------------------------------------------- /QDDSSRC/PARAMETER.PF: -------------------------------------------------------------------------------- 1 | A UNIQUE 2 | A R FPARAM 3 | A PACODE 10 TEXT('Parameter code') 4 | A PASUBCODE 10 TEXT('Parameter sub-Code') 5 | A PARM1 10 TEXT('Parameter 1') 6 | A PARM2 100 TEXT('Parameter 2') 7 | A PARM3 2 TEXT('Parameter 3') 8 | A PARM4 1 0 TEXT('Parameter 4') 9 | A PARM5 3 0 TEXT('Parameter 5') 10 | A K PACODE 11 | A K PASUBCODE 12 | 13 | -------------------------------------------------------------------------------- /QDDSSRC/PRO200D.DSPF: -------------------------------------------------------------------------------- 1 | A*%%TS SD 20161201 160417 VTAQUIN REL-V7R1M0 5770-WDS 2 | A*%%EC 3 | A DSPSIZ(24 80 *DS3) 4 | A INDARA 5 | A CA03(03) 6 | A CA12(12) 7 | A PRINT 8 | A ERRSFL 9 | A R SFL01 SFL 10 | A*%%TS SD 20161025 103254 VTAQUIN REL-V7R1M0 5770-WDS 11 | A 33 SFLNXTCHG 12 | A OPT01 2Y 0B 7 3 13 | A 34 DSPATR(RI) 14 | A 34 DSPATR(PC) 15 | A EDTCDE(Z) 16 | A PRID R O 7 7REFFLD( PRID PROVIDER) 17 | A PROVNM R O 7 13REFFLD( PROVNM PROVIDER) 18 | A PRCITY R O 7 44REFFLD( PRCITY PROVIDER) 19 | A PRDEL R O 7 75REFFLD( PRDEL PROVIDER) 20 | A R CTL01 SFLCTL(SFL01) 21 | A*%%TS SD 20161201 160417 VTAQUIN REL-V7R1M0 5770-WDS 22 | A SFLSIZ(0015) 23 | A SFLPAG(0014) 24 | A N80 PAGEDOWN(25 'dynamic subfile') 25 | A OVERLAY 26 | A 31 SFLDSP 27 | A 32 SFLDSPCTL 28 | A 30 SFLCLR 29 | A 80 SFLEND(*MORE) 30 | A 35 SFLMSG('Invalid Option' 35) 31 | A RRB01 4S 0H SFLRCDNBR 32 | A 1 2'PRO200-1' 33 | A COLOR(BLU) 34 | A 3 4'Type options, press Enter.' 35 | A COLOR(BLU) 36 | A 6 3'Opt' 37 | A DSPATR(HI) 38 | A 1 31'Work with Providers' 39 | A DSPATR(HI) 40 | A 1 70DATE 41 | A EDTCDE(Y) 42 | A 2 70TIME 43 | A 4 6'2=Edit' 44 | A COLOR(BLU) 45 | A 4 17'5=Items ' 46 | A COLOR(BLU) 47 | A 6 7'Id' 48 | A DSPATR(HI) 49 | A 6 13'Provider' 50 | A DSPATR(HI) 51 | A 6 44'City' 52 | A DSPATR(HI) 53 | A 6 74'Del' 54 | A DSPATR(HI) 55 | A 4 30'7=Prepare Order' 56 | A COLOR(BLU) 57 | A R KEY01 58 | A 23 3'F3=Exit' 59 | A COLOR(BLU) 60 | A 23 19'F12=Cancel' 61 | A COLOR(BLU) 62 | 63 | A R FMT02 64 | A*%%TS SD 20161025 163855 VTAQUIN REL-V7R1M0 5770-WDS 65 | A CF04(04) 66 | A 1 2'PRO200-2' 67 | A COLOR(BLU) 68 | A 3 4'Type choices, press Enter.' 69 | A COLOR(BLU) 70 | A 23 3'F3=Exit' 71 | A COLOR(BLU) 72 | A 23 19'F12=Cancel' 73 | A COLOR(BLU) 74 | A 1 34'Edit PROVIDER' 75 | A DSPATR(HI) 76 | A 1 70DATE 77 | A EDTCDE(Y) 78 | A 2 70TIME 79 | A 5 3'Provider Id . . . . . :' 80 | A 6 3'Name . . . . . . . . .' 81 | A PRID R O 5 27REFFLD(PRID PROVIDER) 82 | A PROVNM R B 6 27REFFLD(PROVNM PROVIDER) 83 | A 41 ERRMSG('The name is mandatory' 41) 84 | A 7 3'Phone . . . . . . . . .' 85 | A 8 3'Vat N° . . . . . . . .' 86 | A 9 3'eMail . . . . . . . . .' 87 | A PRMAIL R B 9 27REFFLD(PRMAIL PROVIDER) 88 | A PRPHONE R B 7 27REFFLD(PRPHONE PROVIDER) 89 | A PRVAT R B 8 27REFFLD(PRVAT PROVIDER) 90 | A 10 3'Address . . . . . . . .' 91 | A PRLINE1 R B 10 27REFFLD(PRLINE1 PROVIDER) 92 | A PRLINE2 R B 11 27REFFLD(PRLINE2 PROVIDER) 93 | A PRLINE3 R B 12 27REFFLD(PRLINE3 PROVIDER) 94 | A PRZIP R B 13 27REFFLD(PRZIP PROVIDER) 95 | A PRCITY R B 13 39REFFLD(PRCITY PROVIDER) 96 | A 13 3'Postal Code & City . .' 97 | A 14 3'Country Code . . . . .' 98 | A PRCOUN R B 14 27REFFLD(PRCOUN PROVIDER) 99 | A 40 ERRMSGID(ERR0002 *LIBL/SAMMSGF 40) 100 | A CONAME 30A O 14 31 101 | -------------------------------------------------------------------------------- /QDDSSRC/PRO201D.DSPF: -------------------------------------------------------------------------------- 1 | A*%%TS SD 20161104 151957 VTAQUIN REL-V7R1M0 5770-WDS 2 | A*%%EC 3 | A DSPSIZ(24 80 *DS3) 4 | A CA03(03) 5 | A CA12(12) 6 | A PRINT 7 | A ERRSFL 8 | A R SFL01 SFL 9 | A*%%TS SD 20161104 151639 VTAQUIN REL-V7R1M0 5770-WDS 10 | A 33 SFLNXTCHG 11 | A OPT01 2Y 0B 7 3 12 | A 34 DSPATR(RI) 13 | A 34 DSPATR(PC) 14 | A EDTCDE(Z) 15 | A PRID R O 7 7REFFLD(PRID PROVIDER) 16 | A PROVNM R O 7 13REFFLD(PROVNM PROVIDER) 17 | A PRCITY R O 7 44REFFLD(PRCITY PROVIDER) 18 | A PRDEL R O 7 75REFFLD(PRDEL PROVIDER) 19 | A PRCONT R H REFFLD(FPROV/PRCONT *LIBL/PROVIDER) 20 | A PRPHONE R H REFFLD(FPROV/PRPHONE *LIBL/PROVIDER) 21 | A PRVAT R H REFFLD(FPROV/PRVAT *LIBL/PROVIDER) 22 | A PRMAIL R H REFFLD(FPROV/PRMAIL *LIBL/PROVIDER) 23 | A PRLINE1 R H REFFLD(FPROV/PRLINE1 *LIBL/PROVIDER) 24 | A PRLINE2 R H REFFLD(FPROV/PRLINE2 *LIBL/PROVIDER) 25 | A PRLINE3 R H REFFLD(FPROV/PRLINE3 *LIBL/PROVIDER) 26 | A PRZIP R H REFFLD(FPROV/PRZIP *LIBL/PROVIDER) 27 | A PRCREA R H REFFLD(FPROV/PRCREA *LIBL/PROVIDER) 28 | A R CTL01 SFLCTL(SFL01) 29 | A*%%TS SD 20161104 151957 VTAQUIN REL-V7R1M0 5770-WDS 30 | A SFLSIZ(0015) 31 | A SFLPAG(0014) 32 | A N80 PAGEDOWN 33 | A OVERLAY 34 | A 31 SFLDSP 35 | A 32 SFLDSPCTL 36 | A 30 SFLCLR 37 | A 80 SFLEND(*MORE) 38 | A 35 SFLMSG('Invalid Option') 39 | A RRB01 4S 0H SFLRCDNBR 40 | A 1 2'PRO201-1' 41 | A COLOR(BLU) 42 | A 3 4'Type options, press Enter.' 43 | A COLOR(BLU) 44 | A 6 3'Opt' 45 | A DSPATR(HI) 46 | A 1 70DATE 47 | A EDTCDE(Y) 48 | A 2 70TIME 49 | A 4 6'2=Display' 50 | A COLOR(BLU) 51 | A 4 17'5=Items ' 52 | A COLOR(BLU) 53 | A 6 7'Id' 54 | A DSPATR(HI) 55 | A 6 13'Provider' 56 | A DSPATR(HI) 57 | A 6 44'City' 58 | A DSPATR(HI) 59 | A 6 74'Del' 60 | A DSPATR(HI) 61 | A 1 32'Display Providers' 62 | A DSPATR(HI) 63 | A R KEY01 64 | A 23 3'F3=Exit' 65 | A COLOR(BLU) 66 | A 23 19'F12=Cancel' 67 | A COLOR(BLU) 68 | 69 | A R FMT02 70 | A*%%TS SD 20161104 151957 VTAQUIN REL-V7R1M0 5770-WDS 71 | A CF04(04) 72 | A 1 2'PRO201-2' 73 | A COLOR(BLU) 74 | A 3 4'Type choices, press Enter.' 75 | A COLOR(BLU) 76 | A 23 3'F3=Exit' 77 | A COLOR(BLU) 78 | A 23 19'F12=Cancel' 79 | A COLOR(BLU) 80 | A 1 70DATE 81 | A EDTCDE(Y) 82 | A 2 70TIME 83 | A 5 3'Provider Id . . . . . :' 84 | A 6 3'Name . . . . . . . . :' 85 | A PRID R O 5 27REFFLD(PRID PROVIDER) 86 | A PROVNM R O 6 27REFFLD(PROVNM PROVIDER) 87 | A 41 ERRMSG('The name is mandatory' 41) 88 | A 7 3'Phone . . . . . . . . :' 89 | A 8 3'Vat N° . . . . . . . :' 90 | A 9 3'eMail . . . . . . . . :' 91 | A PRMAIL R O 9 27REFFLD(PRMAIL PROVIDER) 92 | A PRPHONE R O 7 27REFFLD(PRPHONE PROVIDER) 93 | A PRVAT R O 8 27REFFLD(PRVAT PROVIDER) 94 | A 10 3'Address . . . . . . . :' 95 | A PRLINE1 R O 10 27REFFLD(PRLINE1 PROVIDER) 96 | A PRLINE2 R O 11 27REFFLD(PRLINE2 PROVIDER) 97 | A PRLINE3 R O 12 27REFFLD(PRLINE3 PROVIDER) 98 | A PRZIP R O 13 27REFFLD(PRZIP PROVIDER) 99 | A PRCITY R O 13 39REFFLD(PRCITY PROVIDER) 100 | A 13 3'Postal Code & City . :' 101 | A 14 3'Country Code . . . . :' 102 | A PRCOUN R O 14 27REFFLD(PRCOUN PROVIDER) 103 | A 40 ERRMSGID(ERR0002 *LIBL/SAMMSGF 40) 104 | A CONAME 30A O 14 31 105 | A 1 33'Display Provider' 106 | A DSPATR(HI) 107 | -------------------------------------------------------------------------------- /QDDSSRC/PRO202D.DSPF: -------------------------------------------------------------------------------- 1 | A*%%TS SD 20161209 103441 VTAQUIN REL-V7R1M0 5770-WDS 2 | A* %ATTR RSTDSP(*YES) 3 | A*%%EC 4 | A DSPSIZ(24 80 *DS3) 5 | A INDARA 6 | A CA03(03) 7 | A CA12(12) 8 | A PRINT 9 | A ERRSFL 10 | A R SFL01 SFL 11 | A*%%TS SD 20161201 161051 VTAQUIN REL-V7R1M0 5770-WDS 12 | A 33 SFLNXTCHG 13 | A ARID R O 6 2REFFLD(ARID *LIBL/ARTICLE) 14 | A NAME25 25A O 6 9 15 | A ARSTOCK R O 6 35REFFLD(FARTI/ARSTOCK *LIBL/ARTICLE) 16 | A EDTCDE(Z) 17 | A ARMINQTY R O 6 42REFFLD(FARTI/ARMINQTY *LIBL/ARTICLE) 18 | A EDTCDE(Z) 19 | A ARCUSQTY R O 6 49REFFLD(FARTI/ARCUSQTY *LIBL/ARTICLE) 20 | A EDTCDE(Z) 21 | A ARPURQTY R O 6 55REFFLD(FARTI/ARPURQTY *LIBL/ARTICLE) 22 | A EDTCDE(Z) 23 | A NEWORD 5Y 0O 6 62DSPATR(HI) 24 | A EDTCDE(Z) 25 | A APPRICE R O 6 69REFFLD(FARPR/APPRICE *LIBL/ARTIPROV) 26 | A APREF R H REFFLD(APREF ARTIPROV) 27 | A ARDESC R H REFFLD(ARDESC ARTICLE) 28 | A R CTL01 SFLCTL(SFL01) 29 | A*%%TS SD 20161201 160100 VTAQUIN REL-V7R1M0 5770-WDS 30 | A SFLSIZ(0015) 31 | A SFLPAG(0014) 32 | A N80 PAGEDOWN(25 'dynamic subfile') 33 | A CF08(08 'Confirm') 34 | A OVERLAY 35 | A 31 SFLDSP 36 | A 32 SFLDSPCTL 37 | A 30 SFLCLR 38 | A 80 SFLEND(*MORE) 39 | A SFLDROP(CF11) 40 | A 35 SFLMSG('Invalid Option' 35) 41 | A 36 SFLMSG('Closed order can not be edi- 42 | A ted or deleted' 36) 43 | A 37 SFLMSG('Order whith deliveries can - 44 | A not be deleted' 37) 45 | A RRB01 4S 0H SFLRCDNBR 46 | A 1 2'PRO202-1' 47 | A COLOR(BLU) 48 | A 1 28'Prepare Purchase Proposal' 49 | A DSPATR(HI) 50 | A 1 68DATE 51 | A EDTCDE(Y) 52 | A COLOR(BLU) 53 | A 2 4'Provider . . . . :' 54 | A PRID R O 2 23REFFLD(FPROV/PRID *LIBL/PROVIDER) 55 | A PROVNM R O 2 29REFFLD(FPROV/PROVNM *LIBL/PROVIDER) 56 | A 2 68TIME 57 | A COLOR(BLU) 58 | A 3 4'Press to confirm.' 59 | A COLOR(BLU) 60 | A 4 49'Cust' 61 | A DSPATR(HI) 62 | A 4 56'Pur' 63 | A DSPATR(HI) 64 | A 4 63'New' 65 | A DSPATR(HI) 66 | A 5 2'Article' 67 | A DSPATR(HI) 68 | A 5 35'Stock' 69 | A DSPATR(HI) 70 | A 5 42'Min' 71 | A DSPATR(HI) 72 | A 5 49'Order' 73 | A DSPATR(HI) 74 | A 5 55'Order' 75 | A DSPATR(HI) 76 | A 5 62'Order' 77 | A DSPATR(HI) 78 | A 5 69'U Price' 79 | A DSPATR(HI) 80 | A R KEY01 81 | A*%%TS SD 20161201 153426 VTAQUIN REL-V7R1M0 5770-WDS 82 | A 23 3'F3=Exit' 83 | A COLOR(BLU) 84 | A 23 32'F12=Cancel' 85 | A COLOR(BLU) 86 | A 23 17'F8=Confirm' 87 | A COLOR(BLU) 88 | A R FMT03 89 | A*%%TS SD 20161209 103441 VTAQUIN REL-V7R1M0 5770-WDS 90 | A WINDOW(7 10 7 50) 91 | A WDWBORDER((*CHAR '*-*!!*-*')) 92 | A 1 20'Confirmation' 93 | A DSPATR(HI) 94 | A 3 2'XML File' 95 | A 6 2'Press Enter to continue.' 96 | A COLOR(BLU) 97 | A FILENAME 30A O 3 12 98 | A 4 2'created' 99 | A 4 10'in' 100 | A PATH 35A O 4 14 101 | -------------------------------------------------------------------------------- /QDDSSRC/PROVIDE1.LF: -------------------------------------------------------------------------------- 1 | UNIQUE 2 | R FPROV PFILE(PROVIDER) 3 | K PRID 4 | -------------------------------------------------------------------------------- /QDDSSRC/PROVIDER.PF: -------------------------------------------------------------------------------- 1 | REF(SAMREF) 2 | R FPROV 3 | PRID R 4 | PROVNM R 5 | PRCONT 30 TEXT('CONTACT PERSON') 6 | PRPHONE R REFFLD(PHONE) 7 | PRVAT R REFFLD(VATNUM) 8 | PRMAIL R REFFLD(EMAIL) 9 | PRLINE1 R REFFLD(ADRLINE) 10 | PRLINE2 R REFFLD(ADRLINE) 11 | PRLINE3 R REFFLD(ADRLINE) 12 | PRZIP R REFFLD(ZIPCOD) 13 | PRCITY R REFFLD(CITY) 14 | PRCOUN R REFFLD(COID) 15 | PRCREA L TEXT('CREATION DATE') 16 | COLHDG('CREAETION' 'DATE') 17 | PRMOD Z TEXT('LAST MODIFICATION') 18 | COLHDG('LAST' 'MODIFICATION') 19 | PRMODID 10 TEXT('LAS MOD BY') 20 | COLHDG('LAST' 'MODIF.' 'BY') 21 | PRDEL R REFFLD(DLCODE) 22 | -------------------------------------------------------------------------------- /QDDSSRC/Rules.mk: -------------------------------------------------------------------------------- 1 | ARTICLE.FILE: ARTICLE-Article_File.PF SAMREF.FILE 2 | ARTICLE1.FILE: ARTICLE1-Article_File.LF ARTICLE.FILE 3 | ARTICLE2.FILE: ARTICLE2.LF ARTICLE.FILE 4 | ART200D.FILE: ART200D-Work_with_Article.DSPF ARTICLE.FILE VATDEF.FILE 5 | ART301D.FILE: ART301D-Function_Select_an_article.DSPF ARTICLE.FILE VATDEF.FILE 6 | 7 | CUSTOMER.FILE: CUSTOMER.PF SAMREF.FILE 8 | CUSTOME1.FILE: CUSTOME1.LF CUSTOMER.FILE 9 | CUSTOME2.FILE: CUSTOME2.LF CUSTOMER.FILE 10 | CUS200D.FILE: CUS200D.DSPF CUSTOMER.FILE SAMMSGF.MSGF 11 | CUS301D.FILE: CUS301D.DSPF CUSTOMER.FILE 12 | 13 | COUNTRY.FILE: COUNTRY.PF SAMREF.FILE 14 | COUNTR1.FILE: COUNTR1.LF COUNTRY.FILE 15 | COU200D.FILE: COU200D.DSPF SAMREF.FILE CUSTOMER.FILE SAMMSGF.MSGF 16 | COU301D.FILE: COU301D.DSPF 17 | 18 | ORDER.FILE: ORDER.PF SAMREF.FILE 19 | ORDER1.FILE: ORDER1.LF ORDER.FILE 20 | ORDER2.FILE: ORDER2.LF ORDER.FILE 21 | ORDER3.FILE: ORDER3.LF ORDER.FILE 22 | DETORD.FILE: DETORD.PF SAMREF.FILE 23 | DETORD1.FILE: DETORD1.LF DETORD.FILE 24 | ORD100D.FILE: ORD100D.DSPF DETORD.FILE ORDER.FILE VATDEF.FILE 25 | ORD101D.FILE: ORD101D.DSPF DETORD.FILE ORDER.FILE SAMMSGF.MSGF 26 | ORD200D.FILE: ORD200D.DSPF ORDER.FILE CUSTOMER.FILE 27 | ORD201D.FILE: ORD201D.DSPF ORDER.FILE CUSTOMER.FILE 28 | ORD202D.FILE: ORD202D.DSPF DETORD.FILE ARTICLE.FILE CUSTOMER.FILE 29 | ORD500O.FILE: ORD500O.PRTF ORDER.FILE CUSTOMER.FILE DETORD.FILE ARTICLE.FILE 30 | TMPDETORD.FILE: DETORD.FILE 31 | cl "CPYF FROMFILE($(OBJLIB)/DETORD) TOFILE($(OBJLIB)/TMPDETORD) CRTFILE(*YES) MBROPT(*ADD)" 32 | 33 | FAMILLY.FILE: FAMILLY.PF SAMREF.FILE 34 | FAMILL1.FILE: FAMILL1.LF FAMILLY.FILE 35 | FAM301D.FILE: FAM301D.DSPF FAMILLY.FILE 36 | 37 | PROVIDER.FILE: PROVIDER.PF SAMREF.FILE 38 | PROVIDE1.FILE: PROVIDE1.LF PROVIDER.FILE 39 | PRO200D.FILE: PRO200D.DSPF PROVIDER.FILE SAMMSGF.MSGF 40 | PRO201D.FILE: PRO201D.DSPF 41 | 42 | ARTIPROV.FILE: ARTIPROV.PF SAMREF.FILE 43 | ARTIPRO1.FILE: ARTIPRO1.LF ARTIPROV.FILE 44 | ART201D.FILE: ART201D-Work_with_Article.DSPF ARTIPROV.FILE PROVIDER.FILE ARTICLE.FILE 45 | ART202D.FILE: ART202D-Work_with_Article.DSPF 46 | PRO202D.FILE: PRO202D.DSPF ARTIPROV.FILE 47 | 48 | PARAMETER.FILE: PARAMETER.PF 49 | PAR200D.FILE: PAR200D.DSPF PARAMETER.FILE 50 | -------------------------------------------------------------------------------- /QDTASRC/LASTORDNO.DTAARA: -------------------------------------------------------------------------------- 1 | /* Source generated by ARCAD Software */ 2 | /* Using Direct Object GITCO_DTA/LASTORDNO of type *DTAARA */ 3 | /* Time : 2019-07-30-17.57.11.266000 */ 4 | 5 | CRTDTAARA DTAARA(&O/&N) TYPE(*DEC) LEN(6 0) VALUE(60719) TEXT('Last customer Order') 6 | -------------------------------------------------------------------------------- /QDTASRC/Rules.mk: -------------------------------------------------------------------------------- 1 | LASTORDNO.DTAARA: LASTORDNO.DTAARA 2 | STREAMDTA.DTAQ: STREAMDTA.DTAQ 3 | -------------------------------------------------------------------------------- /QDTASRC/STREAMDTA.DTAQ: -------------------------------------------------------------------------------- 1 | /* STREAMDTA Data Queue Object */ 2 | !CRTDTAQ DTAQ(STREAMDTA) MAXLEN(64512) SIZE(*MAX2GB) AUTORCL(*YES) TEXT('Stream Text Dta') 3 | -------------------------------------------------------------------------------- /QILESRC/PAR201.ILEPGM: -------------------------------------------------------------------------------- 1 | /* Source generated by ARCAD Software */ 2 | /* Using Direct Object GITCO_OBJ/PAR201 of type *PGM */ 3 | /* Time : 2019-07-30-17.57.12.204000 */ 4 | 5 | CRTPGM PGM(&O/&N) MODULE(PAR201) ENTMOD(PAR201) BNDSRVPGM(FPARAMETER) + 6 | ACTGRP(QILE) TEXT('Work with generated output') 7 | -------------------------------------------------------------------------------- /QILESRC/PRO200.ILEPGM: -------------------------------------------------------------------------------- 1 | /* Source generated by ARCAD Software */ 2 | /* Using Direct Object GITCO_OBJ/PRO200 of type *PGM */ 3 | /* Time : 2019-07-30-17.57.12.305000 */ 4 | 5 | CRTPGM PGM(&O/&N) MODULE(PRO200 PRO202) ENTMOD(PRO200) + 6 | BNDSRVPGM(XML FCOUNTRY FPARAMETER) ACTGRP(QILE) TEXT('Work with Providers') 7 | -------------------------------------------------------------------------------- /QILESRC/Rules.mk: -------------------------------------------------------------------------------- 1 | PRO200.PGM: PRO200.ILEPGM PRO200.MODULE XML.SRVPGM 2 | PAR201.PGM: PAR201.ILEPGM PAR201.MODULE FPARAMETER.SRVPGM -------------------------------------------------------------------------------- /QILESRVSRC/FARTICLE.ILESRVPGM: -------------------------------------------------------------------------------- 1 | /* Source generated by ARCAD Software */ 2 | /* Using Direct Object GITCO_OBJ/FARTICLE of type *SRVPGM */ 3 | /* Time : 2019-07-30-17.57.12.921000 */ 4 | 5 | CRTSRVPGM SRVPGM(&O/&N) MODULE(ART300 ART301) BNDSRVPGM(FFAMILLY) + 6 | ACTGRP(*CALLER) EXPORT(*ALL) TEXT('Function Article') 7 | -------------------------------------------------------------------------------- /QILESRVSRC/FPARAMETER.ILESRVPGM: -------------------------------------------------------------------------------- 1 | /* Source generated by ARCAD Software */ 2 | /* Using Direct Object GITCO_OBJ/FPARAMETER of type *SRVPGM */ 3 | /* Time : 2019-07-30-17.57.13.285000 */ 4 | 5 | CRTSRVPGM SRVPGM(&O/&N) MODULE(PAR300) ACTGRP(*CALLER) EXPORT(*ALL) TEXT('Parameters functions') 6 | -------------------------------------------------------------------------------- /QILESRVSRC/LOG.ILESRVPGM: -------------------------------------------------------------------------------- 1 | /* Source generated by ARCAD Software */ 2 | /* Using Direct Object GITCO_OBJ/LOG of type *SRVPGM */ 3 | /* Time : 2019-07-30-17.57.13.527000 */ 4 | 5 | CRTSRVPGM SRVPGM(&O/&N) MODULE(LOG300) ACTGRP(*CALLER) EXPORT(*ALL) TEXT('Log Functions') 6 | -------------------------------------------------------------------------------- /QILESRVSRC/Rules.mk: -------------------------------------------------------------------------------- 1 | FARTICLE.SRVPGM: FARTICLE.ILESRVPGM ART300.MODULE ART301.MODULE FFAMILLY.SRVPGM 2 | FPARAMETER.SRVPGM: FPARAMETER.ILESRVPGM PAR300.MODULE 3 | LOG.SRVPGM: LOG.ILESRVPGM LOG300.MODULE -------------------------------------------------------------------------------- /QMSGSRC/Rules.mk: -------------------------------------------------------------------------------- 1 | SAMMSGF.MSGF: SAMMSGF.MSGF 2 | SGSMSGF.MSGF: SGSMSGF.MSGF -------------------------------------------------------------------------------- /QMSGSRC/SAMMSGF.MSGF: -------------------------------------------------------------------------------- 1 | /* Source generated by ARCAD Software */ 2 | /* Using Direct Object GITCO_OBJ/SAMMSGF of type *MSGF */ 3 | /* Time : 2019-07-30-17.57.13.912000 */ 4 | 5 | CRTMSGF MSGF(&O/&N) CCSID(65535) 6 | ADDMSGD MSGID(ERR0001) MSGF(&O/&N) + 7 | MSG('Familly code unknown. Press F4 to select.') SEV(0) CCSID(297) 8 | ADDMSGD MSGID(ERR0002) MSGF(&O/&N) + 9 | MSG('Country code unknown. Press F4 to select.') SEV(0) CCSID(297) 10 | ADDMSGD MSGID(ERR0003) MSGF(&O/&N) + 11 | MSG('Article unknown. Press F4 to select.') SEV(0) CCSID(297) 12 | ADDMSGD MSGID(ERR0004) MSGF(&O/&N) + 13 | MSG('Customer unknown. Press F4 to select.') SEV(0) CCSID(297) 14 | ADDMSGD MSGID(ERR0005) MSGF(&O/&N) + 15 | MSG('Provider unknown. Press F4 to select.') SEV(0) CCSID(297) 16 | ADDMSGD MSGID(ERR1001) MSGF(&O/&N) + 17 | MSG('Delivered quantity must be lower or equal to ordered quantity.') + 18 | SEV(0) CCSID(297) 19 | ADDMSGD MSGID(ERR1002) MSGF(&O/&N) + 20 | MSG('Ordered quantity can not be lower that the quantity already + 21 | delivered.') SEV(0) CCSID(297) 22 | -------------------------------------------------------------------------------- /QMSGSRC/SGSMSGF.MSGF: -------------------------------------------------------------------------------- 1 | /* Source generated by ARCAD Software */ 2 | /* Using Direct Object GITCO_OBJ/SGSMSGF of type *MSGF */ 3 | /* Time : 2019-07-30-17.57.14.028000 */ 4 | 5 | CRTMSGF MSGF(&O/&N) CCSID(65535) 6 | ADDMSGD MSGID(ERR0001) MSGF(&O/&N) + 7 | MSG('Familly code unknown. Press F4 to select.') SEV(0) CCSID(297) 8 | ADDMSGD MSGID(ERR0002) MSGF(&O/&N) + 9 | MSG('Country code unknown. Press F4 to select.') SEV(0) CCSID(297) 10 | ADDMSGD MSGID(ERR0003) MSGF(&O/&N) + 11 | MSG('Article unknown. Press F4 to select.') SEV(0) CCSID(297) 12 | ADDMSGD MSGID(ERR0004) MSGF(&O/&N) + 13 | MSG('Customer unknown. Press F4 to select.') SEV(0) CCSID(297) 14 | ADDMSGD MSGID(ERR0005) MSGF(&O/&N) + 15 | MSG('Provider unknown. Press F4 to select.') SEV(0) CCSID(297) 16 | ADDMSGD MSGID(ERR1001) MSGF(&O/&N) + 17 | MSG('Delivered quantity must be lower or equal to ordered quantity.') + 18 | SEV(0) CCSID(297) 19 | ADDMSGD MSGID(ERR1002) MSGF(&O/&N) + 20 | MSG('Ordered quantity can not be lower that the quantity already + 21 | delivered.') SEV(0) CCSID(297) 22 | -------------------------------------------------------------------------------- /QPNLSRC/Rules.mk: -------------------------------------------------------------------------------- 1 | SAMHELP.PNLGRP: SAMHELP-Help_Application_Sam.PNLGRPSRC 2 | 3 | SAMMNU.MENU: SAMMNU-Main_menu_application_SAMPLE.MENUSRC -------------------------------------------------------------------------------- /QPNLSRC/SAMHELP-Help_Application_Sam.PNLGRPSRC: -------------------------------------------------------------------------------- 1 | :pnlgrp. 2 | :help name=ART200.Work with Articles 3 | :p.Text 4 | :ehelp. 5 | :help name=CUS200.Work with Customers 6 | :p.Text 7 | :ehelp. 8 | :help name=PRO200.Work with Provider 9 | :p.Text 10 | :ehelp. 11 | :help name=NOHELP.Help 12 | :p.Help not available 13 | :ehelp. 14 | :help name=help.Help 15 | :p.Help not available 16 | :ehelp. 17 | :epnlgrp. 18 | -------------------------------------------------------------------------------- /QPNLSRC/SAMMNU-Main_menu_application_SAMPLE.MENUSRC: -------------------------------------------------------------------------------- 1 | :pnlgrp dftmsgf=qcpfmsg 2 | submsgf=sammsgf. 3 | :copyr. 4 | (C) Copyright Arcad Software, 2016. 5 | :import name='*' 6 | pnlgrp=SAMHELP. 7 | :var name=Zmenu. 8 | :KEYL NAME=key01 9 | HELP=help. 10 | :KEYI KEY=F1 11 | HELP=help 12 | ACTION=HELP. 13 | :KEYI KEY=F3 14 | HELP=help 15 | PRIORITY=25 16 | ACTION='exit set'. 17 | F3=Exit 18 | :KEYI KEY=F4 19 | HELP=help 20 | PRIORITY=30 21 | ACTION=PROMPT. 22 | F4=Prompt 23 | :KEYI KEY=F6 24 | HELP=help 25 | PRIORITY=25 26 | ACTION='cmd dspmsg'. 27 | F6=Messages 28 | :KEYI KEY=F9 29 | help=help 30 | ACTION=retrieve 31 | PRIORITY=30. 32 | F9=Retrieve 33 | :KEYI KEY=F10 34 | help=help 35 | PRIORITY=40 36 | ACTION='cmd dspjoblog'. 37 | F10=Job log 38 | :KEYI KEY=F12 39 | help=help 40 | PRIORITY=30 41 | ACTION='cancel set'. 42 | F12=Cancel 43 | :KEYI KEY=F14 44 | help=help 45 | PRIORITY=25 46 | ACTION='cmd wrksbmjob *user'. 47 | F14=Submitted jobs 48 | :KEYI KEY=F24 49 | help=help 50 | ACTION=MOREKEYS. 51 | F24=More keys 52 | :KEYI KEY=ENTER 53 | help=help 54 | ACTION=ENTER. 55 | :KEYI KEY=HELP 56 | HELP=help 57 | ACTION=HELP. 58 | :KEYI KEY=PAGEDOWN 59 | help=help 60 | ACTION=PAGEDOWN. 61 | :KEYI KEY=PAGEUP 62 | help=help 63 | ACTION=PAGEUP. 64 | :KEYI KEY=PRINT 65 | help=help 66 | ACTION=PRINT. 67 | :EKEYL. 68 | :panel name=SAMPLE 69 | help=h 70 | keyl=key01 71 | Enter='msg cpd9817 qcpfmsg' 72 | panelid=zmenu 73 | topsep=sysnam. 74 | Arcad Sample Application 75 | :menu depth='*' 76 | scroll=Yes 77 | Botsep=none. 78 | :Topinst.Select one of the following: 79 | :menugrp.Master files 80 | :menui option=1 81 | action='cmd call ART200' 82 | help=srt200. 83 | Work with Articles ART200 84 | :menui option=2 85 | action='cmd call CUS200' 86 | help=cus200. 87 | Work with Customers CUS200 88 | :menui option=3 89 | action='cmd call ORD201' 90 | help=cus200. 91 | Work with Customer Orders ORD201 92 | :menui option=4 93 | action='cmd call pro200' 94 | help=pro200. 95 | Work with Providers PRO200 96 | :menui option=5 97 | action='cmd call pro201' 98 | help=pro200. 99 | Display Providers PRO201 100 | :menui option=6 101 | action='cmd call ORD100C2' 102 | help=ord100. 103 | Create a Customer Order. ORD100 104 | :emenugrp. 105 | :menugrp.Reports 106 | :menui option=10 107 | action='cmd call pro203' 108 | help=nohelp. 109 | Article to purchase PRO203 110 | :menui option=11 111 | action='cmd STRQMQRY QMQRY(CUSQRY) QMFORM(CUSQRYFMT)' 112 | help=nohelp. 113 | Customer with Open Order QMQRY:CUSQRY 114 | :menui option=12 115 | action='cmd STRQMQRY QMQRY(ARTQRY) ' 116 | help=nohelp. 117 | Article by Last Order Date QMQRY:ARTQRY 118 | :emenugrp. 119 | :menugrp.Utilities 120 | :menui option=20 121 | action='cmd call par200' 122 | help=nohelp. 123 | Work with Parameters PAR200 124 | :menui option=21 125 | action='cmd call cou200' 126 | help=nohelp. 127 | Work with countries COU200 128 | :menui option=80 129 | action='cmd call ord900' 130 | help=nohelp. 131 | Reset LASTORDNO ORD900 132 | :menui option=81 133 | action='cmd call ord901' 134 | help=nohelp. 135 | Reset Order dates to current ORD901 136 | :menui option=82 137 | action='cmd call art801' 138 | help=nohelp. 139 | Reset Summary Fields SQLPRC:ART801 140 | :menui option=83 141 | action='cmd call par201' 142 | help=nohelp. 143 | Work with IFS output PAR201 144 | :menui option=84 145 | action='cmd adspusrspc samlog' 146 | help=nohelp. 147 | Display Application log 148 | :emenugrp. 149 | :menui option=90 150 | action='cmd signoff' 151 | help=nohelp. 152 | Signoff 153 | :emenu. 154 | :cmdline size=long. 155 | Selection or command 156 | :epanel. 157 | :epnlgrp. 158 | -------------------------------------------------------------------------------- /QPNLSRC/wstrig.wscstsrc: -------------------------------------------------------------------------------- 1 | :WSCST DEVCLASS=TRANSFORM. 2 | 3 | :TRNSFRMTBL. 4 | :INITPRT 5 | DATA ='00'X. 6 | :SPACE 7 | DATA ='20'X. 8 | :CARRTN 9 | DATA ='0D'X. 10 | :FORMFEED 11 | DATA ='0C'X. 12 | :LINEFEED 13 | DATA ='0A'X. 14 | :EWSCST. 15 | -------------------------------------------------------------------------------- /QPROTOSRC/.ibmi.json: -------------------------------------------------------------------------------- 1 | { 2 | "version": "0.0.1", 3 | "build": { 4 | "tgtCcsid": "297" 5 | } 6 | } 7 | -------------------------------------------------------------------------------- /QPROTOSRC/APICALL-Prototypes_for_Ibm_API.RPGLEINC: -------------------------------------------------------------------------------- 1 | d crtusrspc pr extpgm('QUSCRTUS') 2 | D usrspc 20 3 | D spc_attr 10 const 4 | D spc_size 10i 0 const 5 | D spc_init 1 const 6 | D spc_aut 10 const 7 | D spc_text 50 const 8 | D spc_replace 10 const 9 | D errcod 256 10 | 11 | d rtvusrspcptr pr extpgm('QUSPTRUS') 12 | D usrspc 20 const 13 | d ptr * 14 | 15 | /if not defined(exec) 16 | D exec pr extpgm('QCMDEXC') 17 | D 3000A options(*varsize) const 18 | D 15P 5 const 19 | D 3A const options(*nopass) 20 | /define exec 21 | /endif 22 | /if not defined(errcod) 23 | d errcod ds 24 | d byte_provided 10i 0 inz(%len(errcod)) 25 | d byte_availabl 10i 0 26 | d error_msgid 7 27 | d 1 28 | d message_data 240 29 | 30 | /define errcod 31 | /endif 32 | -------------------------------------------------------------------------------- /QPROTOSRC/ARTICLE.RPGLEINC: -------------------------------------------------------------------------------- 1 | *============================================= 2 | * Get ARTICLE DESCRPTION 3 | *============================================= 4 | DGetArtDesc PR 50A 5 | D ARID 6A value 6 | *============================================= 7 | * Get REF SALE PRICE 8 | *============================================= 9 | DGetArtRefSalPrice... 10 | D pr 7P 2 11 | D ARID 6A value 12 | *============================================= 13 | * Get STOCK PRICE 14 | *============================================= 15 | DGetArtStockPrice... 16 | D PR 7P 2 17 | D ARID 6A value 18 | *============================================= 19 | * Get FAMILLY ID 20 | *============================================= 21 | DGetArtFam PR 3A 22 | D ARID 6A value 23 | *============================================= 24 | * Get STOCK 25 | *============================================= 26 | DGetArtStock PR 5P 0 27 | D ARID 6A value 28 | *============================================= 29 | * Get MINIMUM STOCK 30 | *============================================= 31 | DGetArtMinStock PR 5P 0 32 | D ARID 6A value 33 | *============================================= 34 | * Get VAT code 35 | *============================================= 36 | DGetArtVatCode Pr 1A 37 | D P_ARID 6A value 38 | *============================================= 39 | * Check if article exist 40 | *============================================= 41 | D ExistArt PR n 42 | D ARID 6A value 43 | *============================================= 44 | * Get DELETE CODE X=DELETED 45 | *============================================= 46 | DIsArtDeleted PR n 47 | D ARID 6A value 48 | *============================================= 49 | * Select an article 50 | *============================================= 51 | D SltArticle PR 6 52 | D ARID 6A value 53 | *============================================= 54 | * Get ARTICLE Info 55 | *============================================= 56 | DGetArtInfo PR 1520A 57 | D ARID 6A value 58 | *============================================= 59 | * Close ARTICLE1 60 | *============================================= 61 | D CloseARTICLE1 PR 62 | -------------------------------------------------------------------------------- /QPROTOSRC/COUNTRY.RPGLEINC: -------------------------------------------------------------------------------- 1 | *============================================= 2 | * Get COUNTRY NAME 3 | *============================================= 4 | DGetCountryName PR 30A 5 | D COID 2A value 6 | *============================================= 7 | * Get Iso Code alpha-3 8 | *============================================= 9 | DGetCountryIso3 PR 3A 10 | D COID 2A value 11 | *============================================= 12 | * Check if country code exist 13 | *============================================= 14 | D ExistCountry PR n 15 | D COID 2A value 16 | *============================================= 17 | * Select a country code 18 | *============================================= 19 | D SltCountry PR 2a 20 | D COID 2A 21 | *============================================= 22 | * Close COUNTRY 23 | *============================================= 24 | D CloseCOUNTRY PR 25 | -------------------------------------------------------------------------------- /QPROTOSRC/CUSTOMER.RPGLEINC: -------------------------------------------------------------------------------- 1 | *============================================= 2 | * Get CUSTOMER NAME 3 | *============================================= 4 | DGetCusName PR 30 5 | D CUID 5 0 value 6 | *============================================= 7 | * Get PHONE NUMBER 8 | *============================================= 9 | DGetCusPhone PR 15 10 | D CUID 5 0 value 11 | *============================================= 12 | * Get VAT NUMBER 13 | *============================================= 14 | DGetCusVat PR 12 15 | D CUID 5 0 value 16 | *============================================= 17 | * Get ADDRESS MAIL 18 | *============================================= 19 | DGetCusMail PR 50 20 | D CUID 5 0 value 21 | *============================================= 22 | * Get ADDRESS LINE 23 | *============================================= 24 | DGetCusAdrline1 PR 50 25 | D CUID 5 0 value 26 | *============================================= 27 | * Get ADDRESS LINE 28 | *============================================= 29 | DGetCusAdrline2 PR 50 30 | D CUID 5 0 value 31 | *============================================= 32 | * Get ADDRESS LINE 33 | *============================================= 34 | DGetCusAdrline3 PR 50 35 | D CUID 5 0 value 36 | *============================================= 37 | * Get ZIP CODE 38 | *============================================= 39 | DGetCusZip PR 10 40 | D CUID 5 0 value 41 | *============================================= 42 | * Get CITY 43 | *============================================= 44 | DGetCusCity PR 30 45 | D CUID 5 0 value 46 | *============================================= 47 | * Get COUNTRY CODE 48 | *============================================= 49 | DGetCusCountry PR 2 50 | D CUID 5 0 value 51 | *============================================= 52 | * Get LIMIT CREDIT 53 | *============================================= 54 | DGetCusLimCredit PR 9 2 55 | D CUID 5 0 value 56 | *============================================= 57 | * Get CREDIT 58 | *============================================= 59 | DGetCusCredit PR 9 2 60 | D CUID 5 0 value 61 | // Remove the comment (//) to test the addition of a function 62 | // PGetCusLastOrdDate... 63 | // D PR 8 0 64 | // D CUID 5 0 value 65 | *============================================= 66 | * Check if customer exist 67 | *============================================= 68 | D ExistCus Pr n 69 | D P_CUID 5 0 value 70 | *============================================= 71 | * Get DELETE CODE X=DELETED 72 | *============================================= 73 | DIsCusDeleted PR n 74 | D CUID 5P 0 value 75 | 76 | D sltcustomer PR 5p 0 77 | D CUID 5P 0 value 78 | *============================================= 79 | * Close CUSTOME1 80 | *============================================= 81 | D CloseCUSTOME1 PR 82 | -------------------------------------------------------------------------------- /QPROTOSRC/FAMILLY.RPGLEINC: -------------------------------------------------------------------------------- 1 | *============================================= 2 | * Get FAMILLY DESCRIPTION 3 | *============================================= 4 | DGetArtFamDesc PR 50 5 | D FAID 3 value 6 | *============================================= 7 | * Ckeck if familly exist 8 | *============================================= 9 | D ExistArtFam PR n 10 | D P_FAID 3 value 11 | *============================================= 12 | * Get DELETE CODE X=DELETED 13 | *============================================= 14 | DIsArtFamDeleted PR n 15 | D FAID 3 value 16 | *============================================= 17 | * Close FAMILLY 18 | *============================================= 19 | D CloseFAMILLY PR 20 | *============================================= 21 | * Select a Failly code 22 | *============================================= 23 | d SltArtFam pr 3 24 | d pcod 3 25 | 26 | -------------------------------------------------------------------------------- /QPROTOSRC/LOG_functions.RPGLEINC: -------------------------------------------------------------------------------- 1 | d AddLogEntry pr 2 | d entry 500 value 3 | -------------------------------------------------------------------------------- /QPROTOSRC/PARAMETER.RPGLEINC: -------------------------------------------------------------------------------- 1 | *============================================= 2 | * Get Parameter 1 3 | *============================================= 4 | DGetPARM1 PR 10A 5 | D PACODE 10A value 6 | D PASUBCODE 10A value 7 | *============================================= 8 | * Get Parameter 2 9 | *============================================= 10 | DGetPARM2 PR 100A 11 | D PACODE 10A value 12 | D PASUBCODE 10A value 13 | *============================================= 14 | * Get Parameter 3 15 | *============================================= 16 | DGetPARM3 PR 2A 17 | D PACODE 10A value 18 | D PASUBCODE 10A value 19 | *============================================= 20 | * Get Parameter 4 21 | *============================================= 22 | DGetPARM4 PR 1P 0 23 | D PACODE 10A value 24 | D PASUBCODE 10A value 25 | *============================================= 26 | * Get Parameter 5 27 | *============================================= 28 | DGetPARM5 PR 3P 0 29 | D PACODE 10A value 30 | D PASUBCODE 10A value 31 | *============================================= 32 | * Close PARAMETER 33 | *============================================= 34 | D ClosePARAMETER PR 35 | -------------------------------------------------------------------------------- /QPROTOSRC/PROVIDER.RPGLEINC: -------------------------------------------------------------------------------- 1 | *============================================= 2 | * Get PROVIDER NAME 3 | *============================================= 4 | DGetProName PR 30A 5 | D PRID 5P 0 value 6 | *============================================= 7 | * Get CONTACT PERSON 8 | *============================================= 9 | DGetProCONT PR 30A 10 | D PRID 5P 0 value 11 | *============================================= 12 | * Get PHONE NUMBER 13 | *============================================= 14 | DGetProPHONE PR 15A 15 | D PRID 5P 0 value 16 | *============================================= 17 | * Get VAT NUMBER 18 | *============================================= 19 | DGetProVAT PR 12A 20 | D PRID 5P 0 value 21 | *============================================= 22 | * Get ADDRESS MAIL 23 | *============================================= 24 | DGetProMAIL PR 50A 25 | D PRID 5P 0 value 26 | *============================================= 27 | * Get ADDRESS LINE 28 | *============================================= 29 | DGetProAdr1 PR 50A 30 | D PRID 5P 0 value 31 | *============================================= 32 | * Get ADDRESS LINE 33 | *============================================= 34 | DGetProAdr2 PR 50A 35 | D PRID 5P 0 value 36 | *============================================= 37 | * Get ADDRESS LINE 38 | *============================================= 39 | DGetProAdr3 PR 50A 40 | D PRID 5P 0 value 41 | *============================================= 42 | * Get ZIP CODE 43 | *============================================= 44 | DGetProZip PR 10A 45 | D PRID 5P 0 value 46 | *============================================= 47 | * Get CITY 48 | *============================================= 49 | DGetProCity PR 30A 50 | D PRID 5P 0 value 51 | *============================================= 52 | * Get COUNTRY CODE 53 | *============================================= 54 | DGetProCountry PR 2A 55 | D PRID 5P 0 value 56 | *============================================= 57 | * Get DELETE CODE X=DELETED 58 | *============================================= 59 | DIsProDeleted PR n 60 | D PRID 5P 0 value 61 | *============================================= 62 | * Check if provider exist 63 | *============================================= 64 | D ExistProvider PR n 65 | D PRID 5P 0 value 66 | *============================================= 67 | * Close PROVIDE1 68 | *============================================= 69 | D ClosePROVIDE1 PR 70 | -------------------------------------------------------------------------------- /QPROTOSRC/README.md: -------------------------------------------------------------------------------- 1 | By renaming to RPGLEINC file extension, there is not longer a need to specify and object-type of *NONE 2 | The member text forces us to generate source-attributes 3 | We could rename to include the text, but that would change all the including source files 4 | -------------------------------------------------------------------------------- /QPROTOSRC/VAT.RPGLEINC: -------------------------------------------------------------------------------- 1 | *============================================= 2 | * Get VAT RATE % 3 | *============================================= 4 | DGetVATRate PR 4P 2 5 | D VATCODE 1A value 6 | *============================================= 7 | * Get VAT description 8 | *============================================= 9 | DGetVATDesc PR 20A 10 | D VATCODE 1A value 11 | *============================================= 12 | * Check VAT Rate 13 | *============================================= 14 | D ExistVATRate PR n 15 | D VATCODE 1A value 16 | *============================================= 17 | * VAT Calculation 18 | *============================================= 19 | D CLCVat PR 9 2 20 | D VATCODE 1 value 21 | D NetValue 9 2 value 22 | *============================================= 23 | * Close VATDEF 24 | *============================================= 25 | D CloseVATDEF PR 26 | -------------------------------------------------------------------------------- /QPROTOSRC/XML.RPGLEINC: -------------------------------------------------------------------------------- 1 | *%CSTD===========================================================* 2 | ** Application. : NEW New Sample * 3 | ** Component. . : XML Type: RPGLE * 4 | **===============================================================* 5 | ** Sub-system . : * 6 | ** Function . . : * 7 | ** Sub-function : * 8 | **%S=============================================================* 9 | ** Description of functions: * 10 | ** * 11 | ** * 12 | ** * 13 | **%E=============================================================* 14 | ** AUTHOR: VTAQUIN 01/12/2016 14:34 01.01.00 * 15 | ** MODIFS: ** VTAQUIN 01/12/2016 : 01.01.00 00/ * 16 | *%ECSTD==========================================================* 17 | D*-------------------------------------- 18 | D* Prototype for procedure: xmlopen 19 | D*-------------------------------------- 20 | D xmlopen PR 21 | d FileName 512a const 22 | D*-------------------------------------- 23 | D* Prototype for procedure: xmlclose 24 | D*-------------------------------------- 25 | D xmlclose PR 26 | D Table 50A value options(*nopass) 27 | D*-------------------------------------- 28 | D* Prototype for procedure: xmlStrTable 29 | D*-------------------------------------- 30 | D xmlStrTable PR 31 | D Table 50A VALUE 32 | D*-------------------------------------- 33 | D* Prototype for procedure: xmlEndTable 34 | D*-------------------------------------- 35 | D xmlEndTable PR 36 | D Table 50A VALUE 37 | D*-------------------------------------- 38 | D* Prototype for procedure: XmlStrRec 39 | D*-------------------------------------- 40 | D XmlStrRec PR 41 | D record 50A value 42 | D*-------------------------------------- 43 | D* Prototype for procedure: XmlXmlAddTag 44 | D*-------------------------------------- 45 | D XmlAddTag PR 46 | D tag 100A value 47 | D*-------------------------------------- 48 | D* Prototype for procedure: XmlEndRec 49 | D*-------------------------------------- 50 | D XmlEndRec PR 51 | D record 50A value 52 | D*-------------------------------------- 53 | D* Prototype for procedure: XmlAddCol 54 | D*-------------------------------------- 55 | D XmlAddCol PR 56 | D name 50A VALUE 57 | D value 200A VALUE -------------------------------------------------------------------------------- /QRPGLESRC/.ibmi.json: -------------------------------------------------------------------------------- 1 | { 2 | "version": "0.0.1", 3 | "build": { 4 | "tgtCcsid": "297" 5 | } 6 | } 7 | -------------------------------------------------------------------------------- /QRPGLESRC/ART300-Function_Article.RPGLE: -------------------------------------------------------------------------------- 1 | h nomain 2 | 3 | FARTICLE1 if e k disk usropn 4 | 5 | /copy article 6 | 7 | d chainARTICLE1 pr 8 | D P_ARID 6A value 9 | 10 | D K_ARID S LIKE(ARID) 11 | 12 | C kf klist 13 | C KFLD K_ARID 14 | 15 | *============================================= 16 | PGetArtDesc B export 17 | DGetArtDesc PI like(ardesc) 18 | D P_ARID 6A value 19 | /free 20 | chainARTICLE1(P_ARID 21 | ); 22 | return ARDESC; 23 | /end-free 24 | pGetArtDesc e 25 | *============================================= 26 | PGetArtRefSalPrice... 27 | P B export 28 | DGetArtRefSalPrice... 29 | D PI like(arsalepr) 30 | D P_ARID 6A value 31 | /free 32 | chainARTICLE1(P_ARID 33 | ); 34 | return ARSALEPR; 35 | /end-free 36 | p e 37 | *============================================= 38 | PGetArtStockPrice... 39 | P B export 40 | DGetArtStockPrice... 41 | D PI like(arwhspr) 42 | D P_ARID 6A value 43 | /free 44 | chainARTICLE1(P_ARID 45 | ); 46 | return ARWHSPR; 47 | /end-free 48 | p e 49 | *============================================= 50 | PGetArtFam B export 51 | DGetArtFam PI like(artifa) 52 | D P_ARID 6A value 53 | /free 54 | chainARTICLE1(P_ARID 55 | ); 56 | return ARTIFA; 57 | /end-free 58 | pGetArtFam e 59 | *============================================= 60 | PGetArtStock B export 61 | DGetArtStock PI like(arstock) 62 | D P_ARID 6A value 63 | /free 64 | chainARTICLE1(P_ARID 65 | ); 66 | return ARSTOCK; 67 | /end-free 68 | pGetArtStock e 69 | *============================================= 70 | PGetArtMinStock B export 71 | DGetArtMinStock PI like(arminqty) 72 | D P_ARID 6A value 73 | /free 74 | chainARTICLE1(P_ARID 75 | ); 76 | return ARMINQTY; 77 | /end-free 78 | pGetArtMinStock e 79 | *============================================= 80 | PGetArtVatCode B export 81 | DGetArtVatCode PI like(arvatcd) 82 | D P_ARID 6A value 83 | /free 84 | chainARTICLE1(P_ARID 85 | ); 86 | return ARvatcd ; 87 | /end-free 88 | pGetArtVatCode e 89 | *============================================= 90 | P ExistArt B export 91 | D ExistArt PI n 92 | D P_ARID 6A value 93 | /free 94 | chainARTICLE1(P_ARID 95 | ); 96 | return %found(article1) and ardel <> 'X'; 97 | /end-free 98 | p ExistArt e 99 | 100 | *============================================= 101 | PIsArtDeleted B export 102 | DIsArtDeleted PI n 103 | D P_ARID 6A value 104 | /free 105 | chainARTICLE1(P_ARID 106 | ); 107 | return ArDEL = 'X'; 108 | /end-free 109 | pIsArtDeleted e 110 | 111 | p chainARTICLE1 b 112 | d chainARTICLE1 pi 113 | D P_ARID 6A value 114 | /free 115 | if not %open(ARTICLE1); 116 | open ARTICLE1; 117 | endif; 118 | if P_ARID <> ARID; 119 | K_ARID = P_ARID; 120 | clear *all FARTI; 121 | chain kf ARTICLE1; 122 | endif; 123 | /end-free 124 | p chainARTICLE1 e 125 | 126 | p closeARTICLE1 b 127 | d closeARTICLE1 pi 128 | /free 129 | if %open(ARTICLE1); 130 | close ARTICLE1; 131 | endif; 132 | /end-free 133 | p closeARTICLE1 e 134 | 135 | 136 | -------------------------------------------------------------------------------- /QRPGLESRC/ART302.SQLRPGLE: -------------------------------------------------------------------------------- 1 | h nomain 2 | 3 | /copy article 4 | 5 | d savInfo s 1520 6 | d savId s 6 7 | *============================================= 8 | PGetArtInfo B export 9 | DGetArtInfo PI 1520 10 | D P_ARID 6A value 11 | /free 12 | if P_arid <> savId; 13 | savid = p_arid; 14 | EXEC SQL 15 | SELECT artinf 16 | INTO :savinfo 17 | FROM artiinf 18 | WHERE arid = :savid; 19 | endif; 20 | 21 | return savinfo; 22 | /end-free 23 | pGetArtInfo e 24 | -------------------------------------------------------------------------------- /QRPGLESRC/COU300.RPGLE: -------------------------------------------------------------------------------- 1 | h nomain 2 | 3 | FCOUNTRY if e k disk usropn 4 | 5 | /copy COUNTRY 6 | 7 | d chainCOUNTRY pr 8 | D P_COID 2A value 9 | 10 | D K_COID S LIKE(COID) 11 | 12 | C kf klist 13 | C KFLD K_COID 14 | 15 | *============================================= 16 | PGetCountryName B export 17 | DGetCountryName PI like(countr) 18 | D P_COID 2A value 19 | /free 20 | chainCOUNTRY(P_COID 21 | ); 22 | return COUNTR; 23 | /end-free 24 | pGetCountryName e 25 | *============================================= 26 | PGetCountryIso3 B export 27 | DGetCountryIso3 PI like(coiso) 28 | D P_COID 2A value 29 | /free 30 | chainCOUNTRY(P_COID 31 | ); 32 | return COISO; 33 | /end-free 34 | pGetCountryIso3 e 35 | 36 | *============================================= 37 | P ExistCountry B export 38 | D ExistCountry PI n 39 | D P_COID 2A value 40 | /free 41 | chainCOUNTRY(P_COID 42 | ); 43 | return %found(country); 44 | /end-free 45 | p ExistCountry e 46 | 47 | p chainCOUNTRY b 48 | d chainCOUNTRY pi 49 | D P_COID 2A value 50 | /free 51 | if not %open(COUNTRY); 52 | open COUNTRY; 53 | endif; 54 | if P_COID <> COID; 55 | K_COID = P_COID; 56 | clear *all FCOUN; 57 | chain kf COUNTRY; 58 | endif; 59 | /end-free 60 | p chainCOUNTRY e 61 | 62 | p closeCOUNTRY b 63 | d closeCOUNTRY pi 64 | /free 65 | if %open(COUNTRY); 66 | close COUNTRY; 67 | endif; 68 | /end-free 69 | p closeCOUNTRY e 70 | 71 | 72 | -------------------------------------------------------------------------------- /QRPGLESRC/DAT001.RPGLE: -------------------------------------------------------------------------------- 1 | 2 | * Status Data Structure 3 | * 4 | d sds 5 | * Program Name 6 | d stPgmName 1 10 7 | * Exception Error Message Text 8 | d stExcText 91 170 9 | 10 | d isotodat pr extpgm('DAT001') 11 | // input 12 | d dat8 8 0 13 | // result 14 | d date d 15 | // Null Indicator Parameters 16 | d dat8_ind 5i 0 17 | d date_ind 5i 0 18 | // SQL Function Parameters 19 | // SQL State - Input/Output 20 | d SQL_State 5 21 | // Function Name Schema.Def name - Input only 22 | d Function_Name 139 23 | // Function Specific Name - Input Only 24 | d Specific_Name 128 25 | // Message Text - Input/Output 26 | d Msg_Text 70 varying 27 | 28 | d isotodat pi 29 | d dat8 8 0 30 | d date d 31 | d dat8_ind 5i 0 32 | d date_ind 5i 0 33 | d SQL_State 5 34 | d Function_Name 139 35 | d Specific_Name 128 36 | d Msg_Text 70 varying 37 | /free 38 | // Clear NULL column indicator and SQL State 39 | date_ind=*zero ; 40 | SQL_State='00000'; 41 | // If valid date return *on 42 | test(de) *iso dat8; 43 | if %error; 44 | date_ind = -1; 45 | else; 46 | date = %date(dat8:*iso); 47 | endif; 48 | return; 49 | 50 | begsr *PSSR; 51 | // Return error code in SQL State (38xxx) 52 | // Set SQL Message Text to first 70 characters of SDS exception text 53 | 54 | SQL_State='38I02'; 55 | Msg_Text=%trimr(stExcText); 56 | return; 57 | endsr; 58 | /end-free 59 | -------------------------------------------------------------------------------- /QRPGLESRC/DAT002.RPGLE: -------------------------------------------------------------------------------- 1 | 2 | * Status Data Structure 3 | * 4 | d sds 5 | * Program Name 6 | d stPgmName 1 10 7 | * Exception Error Message Text 8 | d stExcText 91 170 9 | 10 | d isotodat40 pr extpgm('DAT002') 11 | // input 12 | d dat8 8 0 13 | // result 14 | d date d 15 | // Null Indicator Parameters 16 | d dat8_ind 5i 0 17 | d date_ind 5i 0 18 | // SQL Function Parameters 19 | // SQL State - Input/Output 20 | d SQL_State 5 21 | // Function Name Schema.Def name - Input only 22 | d Function_Name 139 23 | // Function Specific Name - Input Only 24 | d Specific_Name 128 25 | // Message Text - Input/Output 26 | d Msg_Text 70 varying 27 | 28 | d isotodat40 pi 29 | d dat8 8 0 30 | d date d 31 | d dat8_ind 5i 0 32 | d date_ind 5i 0 33 | d SQL_State 5 34 | d Function_Name 139 35 | d Specific_Name 128 36 | d Msg_Text 70 varying 37 | /free 38 | // Clear NULL column indicator and SQL State 39 | date_ind=*zero ; 40 | SQL_State='00000'; 41 | // Special values 42 | if dat8 = 0; 43 | date = D'1940-01-01'; 44 | elseif dat8 = *Hival; 45 | date = D'2039-12-31'; 46 | else; 47 | test(de) *iso dat8; 48 | if %error; 49 | date_ind = -1; 50 | else; 51 | date = %date(dat8:*iso); 52 | endif; 53 | endif; 54 | return; 55 | 56 | begsr *PSSR; 57 | // Return error code in SQL State (38xxx) 58 | // Set SQL Message Text to first 70 characters of SDS exception text 59 | 60 | SQL_State='38I02'; 61 | Msg_Text=%trimr(stExcText); 62 | return; 63 | endsr; 64 | /end-free 65 | -------------------------------------------------------------------------------- /QRPGLESRC/FAM300.RPGLE: -------------------------------------------------------------------------------- 1 | h nomain 2 | 3 | FFAMILLY if e k disk usropn 4 | 5 | /copy FAMILLY 6 | 7 | d chainFAMILLY pr 8 | D P_FAID 3 value 9 | 10 | D K_FAID S LIKE(FAID) 11 | 12 | C kf klist 13 | C KFLD K_FAID 14 | 15 | *============================================= 16 | PGetArtFamDesc B export 17 | DGetArtFamDesc PI like(fadesc) 18 | D P_FAID 3 value 19 | /free 20 | chainFAMILLY(P_FAID 21 | ); 22 | return FADESC; 23 | /end-free 24 | pGetArtFamDesc e 25 | *============================================= 26 | P ExistArtFam B export 27 | D ExistArtFam PI n 28 | D P_FAID 3 value 29 | /free 30 | chainFAMILLY(P_FAID 31 | ); 32 | return %found(familly) AND FADEL<>'D'; 33 | /end-free 34 | p ExistArtFam e 35 | 36 | *============================================= 37 | PIsArtFamDeleted B export 38 | DIsArtFamDeleted PI n 39 | D P_FAID 3 value 40 | /free 41 | chainFAMILLY(P_FAID 42 | ); 43 | return FADEL = 'X'; 44 | /end-free 45 | pIsArtFamDeleted e 46 | 47 | p chainFAMILLY b 48 | d chainFAMILLY pi 49 | D P_FAID 3 value 50 | /free 51 | if not %open(FAMILLY); 52 | open FAMILLY; 53 | endif; 54 | if P_FAID <> FAID; 55 | K_FAID = P_FAID; 56 | clear *all FFAMI; 57 | chain kf FAMILLY; 58 | endif; 59 | /end-free 60 | p chainFAMILLY e 61 | 62 | p closeFAMILLY b 63 | d closeFAMILLY pi 64 | /free 65 | if %open(FAMILLY); 66 | close FAMILLY; 67 | endif; 68 | /end-free 69 | p closeFAMILLY e 70 | 71 | 72 | -------------------------------------------------------------------------------- /QRPGLESRC/LOG100.PGM.RPGLE: -------------------------------------------------------------------------------- 1 | 2 | h dftactgrp(*no) 3 | fparameter if e k disk 4 | f infds(info) 5 | 6 | /copy APICALL-Prototypes_for_Ibm_API 7 | 8 | d info ds 9 | D lib 93 102 10 | 11 | d ds based(p1) 12 | d pos 10i 0 13 | d data 3 14 | 15 | d usrspc s 20 16 | /free 17 | usrspc = 'SAMLOG ' + Lib; 18 | crtusrspc(usrspc:'LOG':5000:X'00':'*ALL':'Sample Application Log' 19 | :'*YES':errcod); 20 | rtvusrspcptr(usrspc:p1); 21 | pos = 7; 22 | data = '***'; 23 | *inlr = *on; 24 | /end-free 25 | -------------------------------------------------------------------------------- /QRPGLESRC/LOG300.RPGLE: -------------------------------------------------------------------------------- 1 | * %XREF XREFTYPE(*OBJ) OBJ(SAMLOG) OBJTYPE(*USRSPC) USAGE(*UPD) 2 | 3 | h nomain 4 | 5 | /copy APICALL-Prototypes_for_Ibm_API 6 | /copy LOG_functions 7 | d init pr 8 | 9 | d pos s 10i 0 based(p1) 10 | d data s 600 based(p2) 11 | d usrspc s 20 12 | d inz s n 13 | d User s 10 inz(*USER) 14 | 15 | p AddLogEntry b export 16 | d AddLogEntry pi 17 | d entry 500 value 18 | 19 | d data2 s 500 varying 20 | /free 21 | if not inz; 22 | init(); 23 | endif; 24 | p2 = p1 + pos; 25 | data2 = 'User: ' +user + ' * '; 26 | data2 += 'Date: ' + %char(%Timestamp()) + ' * ' ; 27 | data2 += 'Msg: ' + %trim(entry) + ' ***' ; 28 | data = data2; 29 | pos += %len(data2); 30 | /end-free 31 | 32 | p AddLogEntry e 33 | 34 | p init b 35 | d init pi 36 | 37 | /free 38 | usrspc = 'SAMLOG *LIBL'; 39 | inz = *on; 40 | rtvusrspcptr(usrspc:p1); 41 | /end-free 42 | 43 | p init e 44 | -------------------------------------------------------------------------------- /QRPGLESRC/ORD202.PGM.RPGLE: -------------------------------------------------------------------------------- 1 | 2 | h dftactgrp(*no) bnddir('SAMPLE') 3 | 4 | fcustome1 if e k disk 5 | farticle1 if e k disk 6 | fdetord1 if e k disk 7 | forder1 if e k disk 8 | ford202d cf e workstn 9 | F indds(indds) 10 | F sfile(sfl01:rrn01) 11 | F Infds(Info) 12 | 13 | d ord202 pr 14 | d id like(orid) 15 | d ord202 pi 16 | d id like(orid) 17 | D indds ds 18 | D help 1 1n 19 | D exit 3 3n 20 | D prompt 4 4n 21 | D refresh 5 5n 22 | D create 6 6n 23 | D cancel 12 12n 24 | D morekeys 24 24n 25 | D pagedown 25 25n 26 | D sflclr 30 30n 27 | D sfldsp 31 31n 28 | D sfldspctl 32 32n 29 | D sflnxtchg 33 33n 30 | D dspatr_ri 34 34n 31 | D sflmsg 35 35n 32 | D sflend 80 80n 33 | 34 | D info ds 35 | D lrrn 378 379i 0 36 | 37 | D rrn01 s 5i 0 38 | D rrs01 s 5i 0 39 | D err01 s n 40 | 41 | D panel S 3i 0 INZ(1) 42 | D step01 S 3 inz(prp) 43 | d User s 10 inz(*user) 44 | d count s 3i 0 45 | d mode s 3 46 | 47 | d crt c 'CRT' 48 | d upd c 'UPD' 49 | d prp c 'prp' 50 | d lod c 'lod' 51 | d dsp c 'dsp' 52 | d key c 'key' 53 | d chk c 'chk' 54 | d act c 'act' 55 | d datBlank c d'1940-01-01' 56 | /free 57 | select; 58 | when panel = 1; 59 | exsr pnl01; 60 | other; 61 | exsr pnl00; 62 | endsl; 63 | //- Subfiles 01 Subroutines -------------------------------------- --- 64 | begsr pnl01; 65 | select ; 66 | when step01 = prp ; 67 | exsr s01prp; 68 | when step01 = lod ; 69 | exsr s01lod; 70 | when step01 = dsp ; 71 | exsr s01dsp; 72 | when step01 = key ; 73 | exsr s01key; 74 | when step01 = act ; 75 | exsr s01act ; 76 | endsl; 77 | endsr; 78 | //--- Clear Subfile ---------------------------------------------------- 79 | begsr s01prp; 80 | chain id order1; 81 | chain orcuid custome1; 82 | datord = %date(ordate:*iso); 83 | if ordatdel > 0; 84 | datliv = %date(ordatdel:*iso); 85 | endif; 86 | if ordatclo > 0; 87 | datclo = %date(ordatclo:*iso); 88 | endif; 89 | RRn01 = 0; 90 | sflclr = *on; 91 | write ctl01; 92 | sflclr = *off; 93 | step01 = lod; 94 | endsr; 95 | //--- Load Subfile ----------------------------------------------------- 96 | begsr s01lod; 97 | RRb01 = RRn01 + 1; 98 | tot = 0; 99 | totvat = 0; 100 | setll id detord1; 101 | reade id detord1; 102 | dow not %eof(detord1); 103 | tot += odtot; 104 | totvat += odtotvat; 105 | chain odarid article1; 106 | RRN01 += 1; 107 | write sfl01; 108 | reade id detord1; 109 | enddo; 110 | sflend = *on; 111 | step01 = dsp; 112 | endsr; 113 | //--- Display Subfile -------------------------------------------------- 114 | begsr s01dsp; 115 | sfldspctl = *on; 116 | sfldsp = RRn01 > 0; 117 | 118 | write key01; 119 | exfmt ctl01; 120 | if LRRN <>0; 121 | RRb01 = LRRN; 122 | endif; 123 | step01 = key; 124 | endsr; 125 | //--- Command Keys ----------------------------------------------------- 126 | begsr s01key; 127 | select; 128 | when exit; 129 | panel = 0; 130 | step01 = prp; 131 | when cancel; 132 | step01 = prp; 133 | panel = 0 ; 134 | other; 135 | step01 = act; 136 | endsl; 137 | endsr; 138 | //--- action Subfile --------------------------------------------------- 139 | begsr s01act; 140 | panel = 0; 141 | endsr; 142 | 143 | //--------INITIALIZATION ---------------------------------- 144 | begsr *inzsr; 145 | datord = datBlank; 146 | datclo = datBlank; 147 | datliv = datBlank; 148 | endsr; 149 | //--------END SUBROUTINE ---------------------------------- 150 | begsr pnl00; 151 | *inlr = *on; 152 | endsr; 153 | /end-free 154 | -------------------------------------------------------------------------------- /QRPGLESRC/ORD700.PGM.RPGLE: -------------------------------------------------------------------------------- 1 | H dftactgrp(*no) bnddir('SAMPLE') 2 | 3 | Farticle1 UF E K DISK 4 | 5 | /copy LOG_functions 6 | 7 | d UpdArt pr 8 | d qty 5 0 value 9 | d id like(new.ODARID) 10 | 11 | D PARM1 DS 12 | * Physical file name 13 | D FNAME 10 14 | * Physical file library 15 | D LNAME 10 16 | * Member name 17 | D MNAME 10 18 | * Trigger event 1=Ins, 2=Del, 3=Upd 19 | D TEVEN 1 20 | * Trigger time 1=After, 2=Before 21 | D TTIME 1 22 | * Commit lock level 23 | D CMTLCK 1 24 | * Reserved 25 | D 3 26 | * CCSID 27 | D CCSID 10i 0 28 | * Reserved 29 | D 8 30 | * Offset to the original record 31 | D OLDOFF 10i 0 32 | * length of the original record 33 | D OLDLEN 10i 0 34 | * Offset to the original record null byte map 35 | D ONOFF 10i 0 36 | * length of the null byte map 37 | D ONLEN 10i 0 38 | * Offset to the new record 39 | D NEWOFF 10i 0 40 | * length of the new record 41 | D NEWLEN 10i 0 42 | * Offset to the new record null byte map 43 | D NNOFF 10i 0 44 | * length of the null byte map 45 | D NNLEN 10i 0 46 | 47 | * Trigger Buffer Length 48 | D parm2 s 10i 0 49 | 50 | * Record to be inserted or new values 51 | D NEW E DS EXTNAME(detord) 52 | D qualified 53 | D based(pn) 54 | 55 | * Record to be deleted or old values 56 | D OLD E DS EXTNAME(detord) 57 | D qualified 58 | D based(po) 59 | 60 | * SET UP THE ENTRY PARAMETER LIST. 61 | 62 | C *ENTRY PLIST 63 | C PARM PARM1 64 | C PARM PARM2 65 | C if %parms = 0 66 | C seton lr 67 | C return 68 | C ENDIF 69 | C select 70 | c when teven = '1' 71 | c eval pn = %addr(parm1) + newoff 72 | c callp UpdArt(new.odqty:new.odarid) 73 | c when teven = '2' 74 | c eval po = %addr(parm1) + oldoff 75 | c callp(e) addlogEntry('ORD700:Order Line deleted ' + 76 | c %char(Old.odorid) + ' ' + %char(Old.odline) 77 | c + ' article : ' + old.odarid 78 | c + ' quantity : ' + %char(old.odqty)) 79 | c callp UpdArt(-Old.odqty + Old.odqtyliv:old.odarid) 80 | c when teven = '3' 81 | c eval pn = %addr(parm1) + newoff 82 | c eval po = %addr(parm1) + oldoff 83 | c if new.odarid = Old.odarid 84 | c callp UpdArt((New.odqty - Old.odqty) 85 | c - (New.odqtyLiv - Old.odqtyLiv) 86 | c :new.odarid) 87 | c else 88 | c callp UpdArt(new.odqty- new.odqtyliv:new.odarid) 89 | c callp UpdArt(-Old.odqty + Old.odqtyliv:old.odarid) 90 | c endif 91 | c endsl 92 | c return 93 | 94 | P UpdArt b 95 | d UpdArt pi 96 | d qty 5 0 value 97 | d id like(new.ODARID) 98 | c if qty = 0 99 | c return 100 | c ENDIF 101 | c id chain article1 102 | c if not %found 103 | c return 104 | c ENDIF 105 | c eval ARCUSQTY += qty 106 | c update farti 107 | P UpdArt e 108 | -------------------------------------------------------------------------------- /QRPGLESRC/ORD900.PGM.RPGLE: -------------------------------------------------------------------------------- 1 | forder1 if e k disk 2 | d next s 6s 0 DTAARA('LASTORDNO') 3 | c *hival setgt order1 4 | c readp order1 5 | c *lock in next 6 | c z-add orid next 7 | c out next 8 | c seton lr 9 | -------------------------------------------------------------------------------- /QRPGLESRC/ORD901.PGM.SQLRPGLE: -------------------------------------------------------------------------------- 1 | forder UF E DISK 2 | 3 | d lastdate s 8 0 4 | d today s 8 0 5 | d days s 5 0 6 | 7 | /free 8 | exec sql select max(ordate) into :LastDate from order; 9 | if lastdate = 0; 10 | *inlr = *on; 11 | return; 12 | ENDIF; 13 | today = %dec(%date():*iso); 14 | days = %diff(%date():%date(lastdate:*iso):*d); 15 | lastdate = %dec(%date() - %days(10):*iso); 16 | read order; 17 | dow not %eof; 18 | ordate = %dec(%date(ordate:*iso) + %days(days):*iso); 19 | if ordatdel > 0; 20 | ordatdel = %dec(%date(ordatdel:*iso) + %days(days):*iso); 21 | if ordatdel > today; 22 | ordatdel = 0; 23 | ENDIF; 24 | ENDIF; 25 | if ordatclo > 0; 26 | ordatclo = %dec(%date(ordatclo:*iso) + %days(days):*iso); 27 | if ordatclo > today ; 28 | ordatclo = 0; 29 | ENDIF; 30 | else; 31 | if ordatdel > 0 and ordatdel < lastdate ; 32 | ordatclo = %dec(%date(ordatdel:*iso) + %days(10):*iso); 33 | ENDIF; 34 | ENDIF; 35 | oryear = %subdt(%date(ordate:*iso):*Y); 36 | update forde; 37 | read order; 38 | ENDDO; 39 | exec sql Update detord d set odyear = (select oryear 40 | from order where d.odorid = orid) 41 | where odyear <> (select oryear 42 | from order where d.odorid = orid) ; 43 | exec sql UPDATE CUSTOMER C SET CULASTORD = 44 | ( SELECT MAX ( ORDATE ) FROM "ORDER" 45 | WHERE C.CUID = ORCUID ) 46 | WHERE EXISTS ( SELECT ORCUID FROM "ORDER" 47 | WHERE C.CUID = ORCUID ); 48 | *inlr = *on; 49 | /end-free 50 | -------------------------------------------------------------------------------- /QRPGLESRC/PAR300.RPGLE: -------------------------------------------------------------------------------- 1 | h nomain 2 | 3 | FPARAMETER if e k disk usropn 4 | 5 | /copy PARAMETER 6 | 7 | d chainPARAMETER pr 8 | D P_PACODE 10A value 9 | D P_PASUBCODE 10A value 10 | 11 | D K_PACODE S LIKE(PACODE) 12 | D K_PASUBCODE S LIKE(PASUBCODE) 13 | 14 | C kf klist 15 | C KFLD K_PACODE 16 | C KFLD K_PASUBCODE 17 | 18 | *============================================= 19 | PGetPARM1 B export 20 | DGetPARM1 PI 10A 21 | D P_PACODE 10A value 22 | D P_PASUBCODE 10A value 23 | /free 24 | chainPARAMETER(P_PACODE 25 | :P_PASUBCODE); 26 | 27 | return PARM1; 28 | /end-free 29 | pGetPARM1 e 30 | *============================================= 31 | PGetPARM2 B export 32 | DGetPARM2 PI 100A 33 | D P_PACODE 10A value 34 | D P_PASUBCODE 10A value 35 | /free 36 | chainPARAMETER(P_PACODE 37 | :P_PASUBCODE); 38 | 39 | return PARM2; 40 | /end-free 41 | pGetPARM2 e 42 | *============================================= 43 | PGetPARM3 B export 44 | DGetPARM3 PI 2A 45 | D P_PACODE 10A value 46 | D P_PASUBCODE 10A value 47 | /free 48 | chainPARAMETER(P_PACODE 49 | :P_PASUBCODE); 50 | 51 | return PARM3; 52 | /end-free 53 | pGetPARM3 e 54 | *============================================= 55 | PGetPARM4 B export 56 | DGetPARM4 PI 1P 0 57 | D P_PACODE 10A value 58 | D P_PASUBCODE 10A value 59 | /free 60 | chainPARAMETER(P_PACODE 61 | :P_PASUBCODE); 62 | 63 | return PARM4; 64 | /end-free 65 | pGetPARM4 e 66 | *============================================= 67 | PGetPARM5 B export 68 | DGetPARM5 PI 3P 0 69 | D P_PACODE 10A value 70 | D P_PASUBCODE 10A value 71 | /free 72 | chainPARAMETER(P_PACODE 73 | :P_PASUBCODE); 74 | 75 | return PARM5; 76 | /end-free 77 | pGetPARM5 e 78 | 79 | p chainPARAMETER b 80 | d chainPARAMETER pi 81 | D P_PACODE 10A value 82 | D P_PASUBCODE 10A value 83 | /free 84 | if not %open(PARAMETER); 85 | open PARAMETER; 86 | endif; 87 | if P_PACODE <> PACODE 88 | or P_PASUBCODE <> PASUBCODE; 89 | K_PACODE = P_PACODE; 90 | K_PASUBCODE = P_PASUBCODE; 91 | clear *all FPARAM; 92 | chain kf PARAMETER; 93 | endif; 94 | /end-free 95 | p chainPARAMETER e 96 | 97 | p closePARAMETER b 98 | d closePARAMETER pi 99 | /free 100 | if %open(PARAMETER); 101 | close PARAMETER; 102 | endif; 103 | /end-free 104 | p closePARAMETER e 105 | 106 | 107 | -------------------------------------------------------------------------------- /QRPGLESRC/PRO300.RPGLE: -------------------------------------------------------------------------------- 1 | h nomain 2 | 3 | FPROVIDE1 if e k disk usropn 4 | 5 | /copy PROVIDER 6 | 7 | d chainPROVIDE1 pr 8 | D P_PRID 5P 0 value 9 | 10 | D K_PRID S LIKE(PRID) 11 | 12 | C kf klist 13 | C KFLD K_PRID 14 | 15 | *============================================= 16 | PGetProName B export 17 | DGetProName PI like(provnm) 18 | D P_PRID 5P 0 value 19 | /free 20 | chainPROVIDE1(P_PRID 21 | ); 22 | return PROVNM; 23 | /end-free 24 | pGetProName e 25 | *============================================= 26 | PGetProCONT B export 27 | DGetProCONT PI like(prcont) 28 | D P_PRID 5P 0 value 29 | /free 30 | chainPROVIDE1(P_PRID 31 | ); 32 | return PRCONT; 33 | /end-free 34 | pGetProCONT e 35 | *============================================= 36 | PGetProPHONE B export 37 | DGetProPHONE PI like(prphone) 38 | D P_PRID 5P 0 value 39 | /free 40 | chainPROVIDE1(P_PRID 41 | ); 42 | return PRPHONE; 43 | /end-free 44 | pGetProPHONE e 45 | *============================================= 46 | PGetProVAT B export 47 | DGetProVAT PI like(prvat) 48 | D P_PRID 5P 0 value 49 | /free 50 | chainPROVIDE1(P_PRID 51 | ); 52 | return PRVAT; 53 | /end-free 54 | pGetProVAT e 55 | *============================================= 56 | PGetProMAIL B export 57 | DGetProMAIL PI like(prmail) 58 | D P_PRID 5P 0 value 59 | /free 60 | chainPROVIDE1(P_PRID 61 | ); 62 | return PRMAIL; 63 | /end-free 64 | pGetProMAIL e 65 | *============================================= 66 | PGetProAdr1 B export 67 | DGetProAdr1 PI like(prline1) 68 | D P_PRID 5P 0 value 69 | /free 70 | chainPROVIDE1(P_PRID 71 | ); 72 | return PRLINE1; 73 | /end-free 74 | pGetProAdr1 e 75 | *============================================= 76 | PGetProAdr2 B export 77 | DGetProAdr2 PI like(prline2) 78 | D P_PRID 5P 0 value 79 | /free 80 | chainPROVIDE1(P_PRID 81 | ); 82 | return PRLINE2; 83 | /end-free 84 | pGetProAdr2 e 85 | *============================================= 86 | PGetProAdr3 B export 87 | DGetProAdr3 PI like(prline3) 88 | D P_PRID 5P 0 value 89 | /free 90 | chainPROVIDE1(P_PRID 91 | ); 92 | return PRLINE3; 93 | /end-free 94 | pGetProAdr3 e 95 | *============================================= 96 | PGetProZip B export 97 | DGetProZip PI like(przip) 98 | D P_PRID 5P 0 value 99 | /free 100 | chainPROVIDE1(P_PRID 101 | ); 102 | return PRZIP; 103 | /end-free 104 | pGetProZip e 105 | *============================================= 106 | PGetProCity B export 107 | DGetProCity PI like(prcity) 108 | D P_PRID 5P 0 value 109 | /free 110 | chainPROVIDE1(P_PRID 111 | ); 112 | return PRCITY; 113 | /end-free 114 | pGetProCity e 115 | *============================================= 116 | PGetProCountry B export 117 | DGetProCountry PI like(prcoun) 118 | D P_PRID 5P 0 value 119 | /free 120 | chainPROVIDE1(P_PRID 121 | ); 122 | return PRCOUN; 123 | /end-free 124 | pGetProCountry e 125 | *============================================= 126 | P ExistProvider B export 127 | D ExistProvider PI n 128 | D P_PRID 5P 0 value 129 | /free 130 | chainPROVIDE1(P_PRID 131 | ); 132 | return %found(provide1) and prdel <> 'X'; 133 | /end-free 134 | p ExistProvider e 135 | 136 | *============================================= 137 | PIsProDeleted B export 138 | DIsProDeleted PI n 139 | D P_PRID 5P 0 value 140 | /free 141 | chainPROVIDE1(P_PRID 142 | ); 143 | return PRDEL = 'X'; 144 | /end-free 145 | pIsProDeleted e 146 | 147 | p chainPROVIDE1 b 148 | d chainPROVIDE1 pi 149 | D P_PRID 5P 0 value 150 | /free 151 | if not %open(PROVIDE1); 152 | open PROVIDE1; 153 | endif; 154 | if P_PRID <> PRID; 155 | K_PRID = P_PRID; 156 | clear *all FPROV; 157 | chain kf PROVIDE1; 158 | endif; 159 | /end-free 160 | p chainPROVIDE1 e 161 | 162 | p closePROVIDE1 b 163 | d closePROVIDE1 pi 164 | /free 165 | if %open(PROVIDE1); 166 | close PROVIDE1; 167 | endif; 168 | /end-free 169 | p closePROVIDE1 e 170 | 171 | 172 | -------------------------------------------------------------------------------- /QRPGLESRC/Rules.mk: -------------------------------------------------------------------------------- 1 | ART200.PGM: ART200-Work_with_article.PGM.SQLRPGLE SAMPLE.BNDDIR 2 | ART201.PGM: ART201-Work_with_article.PGM.RPGLE SAMPLE.BNDDIR 3 | ART202.PGM: ART202-Function_Article.PGM.RPGLE SAMPLE.BNDDIR 4 | LOG100.PGM: LOG100.PGM.RPGLE 5 | ORD100.PGM: ORD100.PGM.RPGLE TMPDETORD.FILE SAMPLE.BNDDIR VATDEF.FILE FVAT.SRVPGM ORDER.FILE ORD100D.FILE 6 | ORD101.PGM: ORD101.PGM.RPGLE 7 | ORD200.PGM: ORD200.PGM.SQLRPGLE 8 | ORD201.PGM: ORD201.PGM.SQLRPGLE 9 | ORD202.PGM: ORD202.PGM.RPGLE 10 | ORD700.PGM: ORD700.PGM.RPGLE QPROTOSRC/LOG_functions.RPGLEINC SAMPLE.BNDDIR 11 | ORD900.PGM: ORD900.PGM.RPGLE 12 | ORD901.PGM: ORD901.PGM.SQLRPGLE 13 | 14 | ART300.MODULE: ART300-Function_Article.RPGLE ARTICLE1.FILE 15 | ART301.MODULE: ART301.SQLRPGLE ART301D.FILE 16 | ART302.MODULE: ART302.SQLRPGLE 17 | COU300.MODULE: COU300.RPGLE COUNTRY.FILE 18 | COU301.MODULE: COU301.RPGLE COUNTRY.FILE COUNTR1.FILE 19 | CUS300.MODULE: CUS300.RPGLE CUSTOME1.FILE 20 | CUS301.MODULE: CUS301.SQLRPGLE CUS301D.FILE 21 | DAT001.MODULE: DAT001.RPGLE 22 | DAT002.MODULE: DAT002.RPGLE 23 | FAM300.MODULE: FAM300.RPGLE FAMILLY.FILE 24 | FAM301.MODULE: FAM301.RPGLE FAMILL1.FILE FAM301D.FILE 25 | LOG300.MODULE: LOG300.RPGLE 26 | PAR200.MODULE: PAR200.RPGLE 27 | PAR300.MODULE: PAR300.RPGLE PARAMETER.FILE 28 | PRO200.MODULE: PRO200.RPGLE FCOUNTRY.SRVPGM FPARAMETER.SRVPGM PRO202.MODULE 29 | PRO202.MODULE: PRO202.SQLRPGLE 30 | PRO300.MODULE: PRO300.RPGLE PROVIDE1.FILE 31 | XML001.MODULE: XML001.RPGLE QPROTOSRC/XML.RPGLEINC QPROTOSRC/txt.rpgleinc 32 | TXT001.MODULE: TXT001.RPGLE 33 | -------------------------------------------------------------------------------- /QRPGLESRC/TXT001.RPGLE: -------------------------------------------------------------------------------- 1 | **free 2 | CTL-OPT NOMAIN; 3 | 4 | dcl-proc txtCloFile Export; 5 | end-proc; 6 | dcl-proc txtCrtFile Export; 7 | DCL-PI *n; 8 | Filename char(1024) const; 9 | new ind const; 10 | END-PI; 11 | end-proc; 12 | dcl-proc txtWrite Export; 13 | DCL-PI *n; 14 | pdata pointer const; 15 | len uns(10:0) const; 16 | END-PI; 17 | end-proc; -------------------------------------------------------------------------------- /QRPGSRC/COU200.RPG: -------------------------------------------------------------------------------- 1 | FCOU200D CF E WORKSTN KINFDS INFDS 2 | F RRN01 KSFILE SFL01 3 | * 4 | FCOUNTRY UF E K DISK 5 | * SCREEN INFORMATION DS. 6 | IINFDS DS 7 | I B 378 3790LRRN 8 | * 9 | C LOOP TAG 10 | C PANEL CASEQ1 PNL01 11 | C PANEL CASEQ2 PNL02 12 | C ENDCS 13 | C PANEL CABEQ0 ENDPGM 14 | C GOTO LOOP 15 | C ENDPGM TAG 16 | C SETON LR 17 | * 18 | C PNL01 BEGSR 19 | C STEP01 CASEQ'PRP' S01PRP 20 | C STEP01 CASEQ'LOD' S01LOD 21 | C STEP01 CASEQ'DSP' S01DSP 22 | C STEP01 CASEQ'KEY' S01KEY 23 | C STEP01 CASEQ'CHK' S01CHK 24 | C STEP01 CASEQ'ACT' S01ACT 25 | C ENDCS 26 | C ENDSR 27 | C S01PRP BEGSR 28 | C Z-ADD0 RRN01 40 29 | C SETON 30 30 | C WRITECTL01 31 | C SETOF 30 32 | C MOVE 'LOD' STEP01 33 | C ENDSR 34 | C S01LOD BEGSR 35 | C RRN01 ADD 1 RRB01 36 | C *LOVAL SETLLCOUNTRY 37 | C READ COUNTRY N 80 38 | C *IN80 DOWEQ*OFF 39 | C ADD 1 RRN01 40 | C WRITESFL01 41 | C READ COUNTRY N 80 42 | C ENDDO 43 | C MOVE 'DSP' STEP01 44 | C ENDSR 45 | C S01DSP BEGSR 46 | C SETON 32 47 | C RRN01 COMP 0 31 48 | C WRITEKEY01 49 | C EXFMTCTL01 50 | C LRRN IFGT 0 51 | C Z-ADDLRRN RRB01 52 | C ENDIF 53 | C MOVE 'KEY' STEP01 54 | C ENDSR 55 | C S01KEY BEGSR 56 | C SELEC 57 | C *IN03 WHEQ *ON 58 | C Z-ADD0 PANEL 59 | C *IN12 WHEQ *ON 60 | C Z-ADD0 PANEL 61 | C OTHER 62 | C MOVE 'CHK' STEP01 63 | C ENDSL 64 | C ENDSR 65 | C S01CHK BEGSR 66 | C MOVE 'ACT' STEP01 67 | C MOVE *OFF ERR01 1 68 | C MOVE *ON *IN33 69 | C READCSFL01 99 70 | C *IN99 DOWEQ*OFF 71 | C OPT01 IFNE 0 72 | C OPT01 ANDNE2 73 | C MOVE 'DSP' STEP01 74 | C SETON 3435 75 | C ERR01 IFEQ *OFF 76 | C Z-ADDRRN01 RRB01 77 | C MOVE *ON ERR01 78 | C ENDIF 79 | C ENDIF 80 | C UPDATSFL01 81 | C SETOF 34 82 | C READCSFL01 99 83 | C ENDDO 84 | C SETOF 33 85 | C ENDSR 86 | C S01ACT BEGSR 87 | C READCSFL01 99 88 | C SELEC 89 | C *IN99 WHEQ *ON 90 | C MOVE 'DSP' STEP01 91 | C OPT01 WHEQ 2 92 | C Z-ADD2 PANEL 93 | C MOVE 'PRP' STEP02 94 | C Z-ADD0 OPT01 95 | C UPDATSFL01 96 | C ENDSL 97 | C ENDSR 98 | C PNL02 BEGSR 99 | C STEP02 CASEQ'PRP' S02PRP 100 | C STEP02 CASEQ'DSP' S02DSP 101 | C STEP02 CASEQ'KEY' S02KEY 102 | C STEP02 CASEQ'CHK' S02CHK 103 | C STEP02 CASEQ'ACT' S02ACT 104 | C ENDCS 105 | C ENDSR 106 | C S02PRP BEGSR 107 | C MOVE 'DSP' STEP02 108 | C COID CHAINCOUNTRY 98 109 | C ENDSR 110 | C S02DSP BEGSR 111 | C EXFMTFMT02 112 | C MOVE 'KEY' STEP02 113 | C ENDSR 114 | C S02KEY BEGSR 115 | C SELEC 116 | C *IN03 WHEQ *ON 117 | C GOTO ENDPGM 118 | C *IN12 WHEQ *ON 119 | C Z-ADD1 PANEL 120 | C OTHER 121 | C MOVE 'CHK' STEP02 122 | C ENDSL 123 | C ENDSR 124 | C S02CHK BEGSR 125 | C MOVE 'ACT' STEP02 126 | C ENDSR 127 | C S02ACT BEGSR 128 | C UPDATFCOUN 129 | C Z-ADD1 PANEL 130 | C ENDSR 131 | C *INZSR BEGSR 132 | C Z-ADD1 PANEL 10 133 | C MOVE 'PRP' STEP01 3 134 | C MOVE 'PRP' STEP02 3 135 | C ENDSR 136 | -------------------------------------------------------------------------------- /QRPGSRC/Rules.mk: -------------------------------------------------------------------------------- 1 | COU200.PGM: COU200.RPG COUNTRY.FILE COU200D.FILE 2 | -------------------------------------------------------------------------------- /QSQLCPPSRC/Rules.mk: -------------------------------------------------------------------------------- 1 | ANZ_FILE.MODULE: ANZ_FILE.SQLCPP 2 | ANZ_FILE.MODULE: private OPTION = *SYS *EVENTF 3 | ANZ_FILE.PGM: private ACTGRP = *CALLER 4 | ANZ_FILE.PGM: ANZ_FILE.MODULE 5 | -------------------------------------------------------------------------------- /QSQLCSRC/Rules.mk: -------------------------------------------------------------------------------- 1 | ANZ_FILE2.MODULE: private INLINE = *ON *AUTO *NOLIMIT *NOLIMIT *YES 2 | ANZ_FILE2.MODULE: private DBGVIEW = *NONE 3 | ANZ_FILE2.MODULE: private OPTIMIZE = 40 4 | ANZ_FILE2.MODULE: ANZ_FILE2.SQLC 5 | ANZ_FILE2.PGM: private ACTGRP = *CALLER 6 | ANZ_FILE2.PGM: ANZ_FILE2.MODULE 7 | 8 | -------------------------------------------------------------------------------- /QSQLSRC/.ibmi.json: -------------------------------------------------------------------------------- 1 | { 2 | "version": "0.0.1", 3 | "build": { 4 | "tgtCcsid": "297" 5 | } 6 | } 7 | -------------------------------------------------------------------------------- /QSQLSRC/ART801.SQLPRC: -------------------------------------------------------------------------------- 1 | --%METADATA * 2 | -- %TEXT Update Customer Order Quantity * 3 | --%EMETADATA * 4 | 5 | SET PATH *LIBL ; 6 | 7 | CREATE OR REPLACE PROCEDURE UPDATE_ON_CUS_ORD_QTY ( ) 8 | LANGUAGE SQL 9 | SPECIFIC ART801 10 | NOT DETERMINISTIC 11 | MODIFIES SQL DATA 12 | CALLED ON NULL INPUT 13 | SET OPTION ALWBLK = *ALLREAD , 14 | ALWCPYDTA = *YES , 15 | COMMIT = *NONE , 16 | DECRESULT = (31, 31, 00) , 17 | 18 | DLYPRP = *NO , 19 | DYNDFTCOL = *NO , 20 | DYNUSRPRF = *USER , 21 | SRTSEQ = *HEX 22 | BEGIN 23 | -- UPDATE ON CUST ORDER QUANTITY ON ARTICLE 24 | UPDATE ARTICLE A SET ARCUSQTY = ( SELECT SUM ( ODQTY - ODQTYLIV) FROM "ORDER" 25 | , DETORD 26 | WHERE ORID = ODORID AND ORDATCLO = 0 AND A.ARID = ODARID GROUP BY ODARID ) 27 | WHERE EXISTS ( SELECT ODARID FROM "ORDER" , DETORD WHERE ORID = ODORID AND 28 | ORDATCLO = 0 AND A.ARID = ODARID ); 29 | -- UPDATE CURRENT CREDIT FROM CUSTOMER 30 | UPDATE CUSTOMER C SET CUCREDIT = ( SELECT SUM ( ODTOTVAT ) FROM "ORDER" 31 | , DETORD 32 | WHERE ORID = ODORID AND ORDATCLO = 0 AND C.CUID = ORCUID GROUP BY ORCUID ) 33 | WHERE EXISTS ( SELECT ORCUID FROM "ORDER" , DETORD WHERE ORID = ODORID AND 34 | ORDATCLO = 0 AND C.CUID = ORCUID ); 35 | -- UPDATE LAST ORDER DATE FROM CUSTOMER 36 | UPDATE CUSTOMER C SET CULASTORD = ( SELECT MAX ( ORDATE ) FROM "ORDER" 37 | WHERE C.CUID = ORCUID ) 38 | WHERE EXISTS ( SELECT ORCUID FROM "ORDER" WHERE C.CUID = ORCUID ); 39 | END; 40 | 41 | 42 | 43 | 44 | -------------------------------------------------------------------------------- /QSQLSRC/ARTIINF.TABLE: -------------------------------------------------------------------------------- 1 | 2 | CREATE OR REPLACE TABLE ARTIINF ( 3 | ARTICLE_INFO_ID FOR COLUMN ARID CHAR(6) 4 | CCSID 297 NOT NULL DEFAULT '' , 5 | ARTICLE_INFORMATION FOR COLUMN ARTINF VARCHAR(1520) 6 | CCSID 297 NOT NULL DEFAULT '' ) 7 | ; 8 | 9 | LABEL ON TABLE ARTIINF 10 | IS 'Article Informations File' ; 11 | 12 | LABEL ON COLUMN ARTIINF 13 | ( ARTICLE_INFO_ID IS 'ARTICLE ID' , 14 | ARTICLE_INFORMATION IS 'ARTICLE INFORMATION' ) ; 15 | 16 | -------------------------------------------------------------------------------- /QSQLSRC/ARTLSTDAT.VIEW: -------------------------------------------------------------------------------- 1 | --%METADATA * 2 | -- %TEXT Articles with total ordered per desc and date * 3 | --%EMETADATA * 4 | CREATE 5 | OR REPLACE VIEW ARTLSTDAT ( 6 | ARID, 7 | ARDESC, 8 | LASTORDER, 9 | QUANTITY 10 | ) AS 11 | SELECT 12 | ARID, 13 | ARDESC, 14 | MAX(ORDATE) AS LASTORDER, 15 | SUM(ODQTY) AS QUANTITY 16 | FROM 17 | ARTICLE, 18 | "ORDER", 19 | DETORD 20 | WHERE 21 | ARID = ODARID 22 | AND ODORID = ORID 23 | GROUP BY 24 | ARID, 25 | ARDESC; 26 | 27 | LABEL ON COLUMN ARTLSTDAT ( 28 | ARID IS 'ART. ID', 29 | ARDESC IS 'DESCRIPTION' 30 | ); 31 | 32 | LABEL ON COLUMN ARTLSTDAT ( 33 | ARID TEXT IS 'ARTICLE ID', 34 | ARDESC TEXT IS 'ARTICLE DESCRPTION' 35 | ); -------------------------------------------------------------------------------- /QSQLSRC/CUSSEQ.SQLSEQ: -------------------------------------------------------------------------------- 1 | --%METADATA * 2 | -- %TEXT Sequence by customer number * 3 | --%EMETADATA * 4 | 5 | CREATE OR REPLACE SEQUENCE CUSSEQ 6 | START WITH 1551 7 | INCREMENT BY 1 8 | NO MAXVALUE 9 | NO CYCLE; 10 | 11 | LABEL ON SEQUENCE CUSSEQ IS 'Next customer Number'; 12 | -------------------------------------------------------------------------------- /QSQLSRC/ISOTODATE.SQLUDF: -------------------------------------------------------------------------------- 1 | CREATE OR REPLACE FUNCTION ISOTODATE ( 2 | DECIMAL(8, 0) ) 3 | RETURNS DATE 4 | LANGUAGE RPGLE 5 | SPECIFIC ISOTODATE 6 | DETERMINISTIC 7 | NO SQL 8 | RETURNS NULL ON NULL INPUT 9 | NO EXTERNAL ACTION 10 | EXTERNAL NAME DAT001 11 | PARAMETER STYLE SQL ; 12 | -------------------------------------------------------------------------------- /QSQLSRC/ISOTODATE4.SQLUDF: -------------------------------------------------------------------------------- 1 | CREATE OR REPLACE FUNCTION ISOTODATE40 ( 2 | DECIMAL(8, 0) ) 3 | RETURNS DATE 4 | LANGUAGE RPGLE 5 | SPECIFIC ISOTODATE4 6 | DETERMINISTIC 7 | NO SQL 8 | RETURNS NULL ON NULL INPUT 9 | NO EXTERNAL ACTION 10 | EXTERNAL NAME DAT002 11 | PARAMETER STYLE SQL ; 12 | -------------------------------------------------------------------------------- /QSQLSRC/ORD701.SQLTRG: -------------------------------------------------------------------------------- 1 | --%METADATA * 2 | -- %TEXT Trigger inserting order date * 3 | --%EMETADATA * 4 | 5 | Create Or Replace Trigger ORD701_Insert_order 6 | After Insert on order 7 | Referencing New As N 8 | 9 | For Each Row 10 | Program Name ORD701 11 | set option sqlPath = *LIBL 12 | Begin 13 | 14 | Update Customer set culastord = n.ordate 15 | where cuid = N.orcuid; 16 | End 17 | -------------------------------------------------------------------------------- /QSQLSRC/ORDERCUS.VIEW: -------------------------------------------------------------------------------- 1 | CREATE OR REPLACE VIEW ORDERCUS ( 2 | ORID, 3 | ORCUID, 4 | CUSTNM, 5 | ORYEAR, 6 | ORDATE, 7 | ORDATDEL, 8 | ORDATCLO, 9 | TOTVAL 10 | ) AS 11 | SELECT ORID, 12 | ORCUID, 13 | CUSTNM, 14 | ORYEAR, 15 | ORDATE, 16 | ORDATDEL, 17 | ORDATCLO, 18 | COALESCE((SELECT SUM(ODTOTVAT) 19 | FROM DETORD D 20 | WHERE H.ORID = ODORID), 21 | 0) AS TOTVAL 22 | FROM "ORDER" H, 23 | CUSTOMER 24 | WHERE ORCUID = CUID; 25 | 26 | 27 | LABEL ON COLUMN ORDERCUS 28 | ( ORID IS 'ORD NUM' , 29 | ORCUID IS 'CUST ID' , 30 | CUSTNM IS 'CUSTOMER NAME' , 31 | ORYEAR IS 'YEAR' ) ; 32 | 33 | LABEL ON COLUMN ORDERCUS 34 | ( ORID TEXT IS 'ORDER NUMBER' , 35 | ORCUID TEXT IS 'CUSTOMER ID' , 36 | CUSTNM TEXT IS 'CUSTOMER NAME' , 37 | ORYEAR TEXT IS 'YEAR' ) ; 38 | -------------------------------------------------------------------------------- /QSQLSRC/Rules.mk: -------------------------------------------------------------------------------- 1 | # ISOTODATE.SRVPGM ISOTODATE4.SRVPGM 2 | ART801.PGM: ART801.SQLPRC 3 | ARTLSTDAT.FILE: ARTLSTDAT.VIEW 4 | #ISOTODATE.SRVPGM: ISOTODATE.SQLUDF 5 | ORD701.PGM: ORD701.SQLTRG 6 | ARTIINF.FILE: ARTIINF.TABLE 7 | CUSSEQ.DTAARA: CUSSEQ.SQLSEQ 8 | #ISOTODATE4.SRVPGM: ISOTODATE4.SQLUDF 9 | ORDERCUS.FILE: ORDERCUS.VIEW -------------------------------------------------------------------------------- /QSQLSRC/readme.md: -------------------------------------------------------------------------------- 1 | Note that TEXT attribute is represented by LABEL ON SQL command -------------------------------------------------------------------------------- /QSRVSRC/.ibmi.json: -------------------------------------------------------------------------------- 1 | { 2 | "version": "0.0.1", 3 | "build": { 4 | "tgtCcsid": "297" 5 | } 6 | } 7 | -------------------------------------------------------------------------------- /QSRVSRC/FARTICLE.BND: -------------------------------------------------------------------------------- 1 | STRPGMEXP PGMLVL(*CURRENT) SIGNATURE('V1') 2 | EXPORT SYMBOL('EXISTART') 3 | EXPORT SYMBOL('GETARTDESC') 4 | EXPORT SYMBOL('GETARTFAM') 5 | EXPORT SYMBOL('GETARTMINSTOCK') 6 | EXPORT SYMBOL('GETARTREFSALPRICE') 7 | EXPORT SYMBOL('GETARTSTOCK') 8 | EXPORT SYMBOL('GETARTSTOCKPRICE') 9 | EXPORT SYMBOL('GETARTVATCODE') 10 | EXPORT SYMBOL('ISARTDELETED') 11 | EXPORT SYMBOL('SLTARTICLE') 12 | ENDPGMEXP 13 | -------------------------------------------------------------------------------- /QSRVSRC/FCOUNTRY.BND: -------------------------------------------------------------------------------- 1 | STRPGMEXP PGMLVL(*CURRENT) SIGNATURE('V1') 2 | EXPORT SYMBOL('EXISTCOUNTRY') 3 | EXPORT SYMBOL('GETCOUNTRYISO3') 4 | EXPORT SYMBOL('GETCOUNTRYNAME') 5 | EXPORT SYMBOL('SLTCOUNTRY') 6 | ENDPGMEXP 7 | -------------------------------------------------------------------------------- /QSRVSRC/FCUSTOMER.BND: -------------------------------------------------------------------------------- 1 | STRPGMEXP PGMLVL(*CURRENT) SIGNATURE('V1') 2 | EXPORT SYMBOL('EXISTCUS') 3 | EXPORT SYMBOL('GETCUSADRLINE1') 4 | EXPORT SYMBOL('GETCUSADRLINE2') 5 | EXPORT SYMBOL('GETCUSADRLINE3') 6 | EXPORT SYMBOL('GETCUSCITY') 7 | EXPORT SYMBOL('GETCUSCOUNTRY') 8 | EXPORT SYMBOL('GETCUSCREDIT') 9 | EXPORT SYMBOL('GETCUSLIMCREDIT') 10 | EXPORT SYMBOL('GETCUSMAIL') 11 | EXPORT SYMBOL('GETCUSNAME') 12 | EXPORT SYMBOL('GETCUSPHONE') 13 | EXPORT SYMBOL('GETCUSVAT') 14 | EXPORT SYMBOL('GETCUSZIP') 15 | EXPORT SYMBOL('ISCUSDELETED') 16 | EXPORT SYMBOL('SLTCUSTOMER') 17 | ENDPGMEXP 18 | -------------------------------------------------------------------------------- /QSRVSRC/FFAMILLY.BND: -------------------------------------------------------------------------------- 1 | STRPGMEXP PGMLVL(*CURRENT) SIGNATURE('V1') 2 | EXPORT SYMBOL('GETARTFAMDESC') 3 | EXPORT SYMBOL('EXISTARTFAM') 4 | EXPORT SYMBOL('ISARTFAMDELETED') 5 | EXPORT SYMBOL('SLTARTFAM') 6 | ENDPGMEXP 7 | -------------------------------------------------------------------------------- /QSRVSRC/FPROVIDER.BND: -------------------------------------------------------------------------------- 1 | STRPGMEXP PGMLVL(*CURRENT) 2 | /********************************************************************/ 3 | /* *MODULE PRO300 NEWSAMPLE 25/10/16 17:20:41 */ 4 | /********************************************************************/ 5 | EXPORT SYMBOL('EXISTPROVIDER') 6 | EXPORT SYMBOL('GETPROADR1') 7 | EXPORT SYMBOL('GETPROADR2') 8 | EXPORT SYMBOL('GETPROADR3') 9 | EXPORT SYMBOL('GETPROCITY') 10 | EXPORT SYMBOL('GETPROCONT') 11 | EXPORT SYMBOL('GETPROCOUNTRY') 12 | EXPORT SYMBOL('GETPROMAIL') 13 | EXPORT SYMBOL('GETPRONAME') 14 | EXPORT SYMBOL('GETPROPHONE') 15 | EXPORT SYMBOL('GETPROVAT') 16 | EXPORT SYMBOL('GETPROZIP') 17 | EXPORT SYMBOL('ISPRODELETED') 18 | ENDPGMEXP 19 | -------------------------------------------------------------------------------- /QSRVSRC/Rules.mk: -------------------------------------------------------------------------------- 1 | FCOUNTRY.SRVPGM: FCOUNTRY.BND COU300.MODULE COU301.MODULE 2 | FCOUNTRY.SRVPGM: TEXT = Functions Country 3 | FCUSTOMER.SRVPGM: FCUSTOMER.BND CUS300.MODULE CUS301.MODULE 4 | FCUSTOMER.SRVPGM: TEXT = Functions Customer 5 | FFAMILLY.SRVPGM: FFAMILLY.BND FAM300.MODULE FAM301.MODULE 6 | FFAMILLY.SRVPGM: TEXT = Functions Family 7 | FPROVIDER.SRVPGM: FPROVIDER.BND PRO300.MODULE 8 | FPROVIDER.SRVPGM: TEXT = Functions Provider 9 | TXT.SRVPGM: TXT.BND TXT001.MODULE 10 | XML.SRVPGM: XML.BND XML001.MODULE TXT.SRVPGM -------------------------------------------------------------------------------- /QSRVSRC/TXT.BND: -------------------------------------------------------------------------------- 1 | /*%CSTD===========================================================* */ 2 | /** Application. : ARC_DEMO PRD:Tools used by Demo appli. * */ 3 | /** Composant. . : TXT Type: BND * */ 4 | /**===============================================================* */ 5 | /** Sous-syst}me : * */ 6 | /** Fonction . . : * */ 7 | /** Sous-fonction: * */ 8 | /**%S=============================================================* */ 9 | /** Description des fonctionnalit{s: * */ 10 | /** * */ 11 | /** * */ 12 | /** * */ 13 | /**%E=============================================================* */ 14 | /** AUTEUR: VTAQUIN 14/06/2017 17:02 01.00.09 * */ 15 | /** MODIFS: ** VTAQUIN 14/06/2017 : 01.00.09 00/ * */ 16 | /*%ECSTD==========================================================* */ 17 | STRPGMEXP PGMLVL(*CURRENT) SIGNATURE('V1') 18 | EXPORT SYMBOL("TXTWRITE") 19 | EXPORT SYMBOL("TXTCLOFILE") 20 | EXPORT SYMBOL("TXTCRTFILE") 21 | ENDPGMEXP -------------------------------------------------------------------------------- /QSRVSRC/XML.BND: -------------------------------------------------------------------------------- 1 | /*%CSTD===========================================================* */ 2 | /** Application. : ARC_DEMO PRD:Tools used by Demo appli. * */ 3 | /** Composant. . : XML Type: BND * */ 4 | /**===============================================================* */ 5 | /** Sous-syst}me : * */ 6 | /** Fonction . . : * */ 7 | /** Sous-fonction: * */ 8 | /**%S=============================================================* */ 9 | /** Description des fonctionnalit{s: * */ 10 | /** * */ 11 | /** * */ 12 | /** * */ 13 | /**%E=============================================================* */ 14 | /** AUTEUR: VTAQUIN 14/06/2017 17:02 01.00.09 * */ 15 | /** MODIFS: ** VTAQUIN 14/06/2017 : 01.00.09 00/ * */ 16 | /*%ECSTD==========================================================* */ 17 | STRPGMEXP PGMLVL(*CURRENT) SIGNATURE('V1') 18 | EXPORT SYMBOL("XMLADDCOL") 19 | EXPORT SYMBOL("XMLADDTAG") 20 | EXPORT SYMBOL("XMLCLOSE") 21 | EXPORT SYMBOL("XMLENDREC") 22 | EXPORT SYMBOL("XMLENDTABLE") 23 | EXPORT SYMBOL("XMLOPEN") 24 | EXPORT SYMBOL("XMLSTRREC") 25 | EXPORT SYMBOL("XMLSTRTABLE") 26 | ENDPGMEXP -------------------------------------------------------------------------------- /QTRGSRC/.ibmi.json: -------------------------------------------------------------------------------- 1 | { 2 | "version": "0.0.1", 3 | "build": { 4 | "tgtCcsid": "297" 5 | } 6 | } 7 | -------------------------------------------------------------------------------- /QTRGSRC/ORD700A.SYSTRG: -------------------------------------------------------------------------------- 1 | ADDPFTRG FILE(DETORD) TRGTIME(*AFTER) + 2 | TRGEVENT(*INSERT) PGM(ORD700) + 3 | RPLTRG(*YES) + 4 | TRG(ORD700_DETORD_ARTICLE_INSERT) 5 | -------------------------------------------------------------------------------- /QTRGSRC/ORD700D.SYSTRG: -------------------------------------------------------------------------------- 1 | ADDPFTRG FILE(DETORD) TRGTIME(*AFTER) + 2 | TRGEVENT(*DELETE) PGM(ORD700) + 3 | RPLTRG(*YES) + 4 | TRG(ORD700_DETORD_ARTICLE_DELETE) 5 | -------------------------------------------------------------------------------- /QTRGSRC/ORD700U.SYSTRG: -------------------------------------------------------------------------------- 1 | ADDPFTRG FILE(DETORD) TRGTIME(*AFTER) + 2 | TRGEVENT(*UPDATE) PGM(ORD700) + 3 | RPLTRG(*YES) + 4 | TRG(ORD700_DETORD_ARTICLE_UPDATE) + 5 | TRGUPDCND(*CHANGE) 6 | -------------------------------------------------------------------------------- /QTRGSRC/Rules.mk: -------------------------------------------------------------------------------- 1 | ORD700A.TRG: ORD700A.SYSTRG ORD700.PGM 2 | ORD700D.TRG: ORD700D.SYSTRG ORD700.PGM 3 | ORD700U.TRG: ORD700U.SYSTRG ORD700.PGM -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Sample IBM i application with multiple source types using project metadata defined in iproj.json. 2 | Changed for COMMON Demo -------------------------------------------------------------------------------- /Rules.mk: -------------------------------------------------------------------------------- 1 | SUBDIRS = QBNDSRC QCBLSRC QCLSRC QCMDSRC QDDSSRC QDTASRC QILESRC QILESRVSRC QMSGSRC QPNLSRC QRPGLESRC QRPGSRC QSQLSRC QSRVSRC QCSRC QCPPSRC QSQLCSRC QSQLCPPSRC common functionsVAT globalization 2 | -------------------------------------------------------------------------------- /common/Rules.mk: -------------------------------------------------------------------------------- 1 | PFs := SAMREF.FILE 2 | SAMREF.FILE: $(d)/SAMREF.PF -------------------------------------------------------------------------------- /common/SAMREF.PF: -------------------------------------------------------------------------------- 1 | R REFER 2 | * 3 | ADID 5P 0 TEXT('ADDRESS ID') 4 | COLHDG('ADRES.' 'ID') 5 | EDTCDE(Z) 6 | ADRLINE 50 TEXT('ADDRESS LINE') 7 | COLHDG('ADDRESS' 'LINE') 8 | ARID 6 TEXT('ARTICLE ID') 9 | COLHDG('ART.' 'ID') 10 | ARDESC 50 TEXT('ARTICLE DESCRPTION') 11 | COLHDG('DESCRIPTION') 12 | CUID 5P 0 TEXT('CUSTOMER ID') 13 | COLHDG('CUST' 'ID') 14 | EDTCDE(Z) 15 | COID 2 TEXT('COUNTRY CODE') 16 | COLHDG('CO' 'ID') 17 | COUNTR 30 TEXT('COUNTRY NAME') 18 | COLHDG('COUNTRY' 'NAME') 19 | CITY 30 TEXT('CITY') 20 | COLHDG('CITY') 21 | CUSTNM 30 TEXT('CUSTOMER NAME') 22 | COLHDG('CUSTOMER' 'NAME') 23 | DLCODE 1 COLHDG('DEL' 'CD') 24 | TEXT('DELETE CODE X=DELETED') 25 | FAID 3 TEXT('FAMILLY ID') 26 | COLHDG('FAM' 'ID') 27 | FADESC 50 TEXT('FAMILLY DESCRIPTION') 28 | COLHDG('FAMILLY') 29 | EMAIL 50 TEXT('ADDRESS MAIL') 30 | COLHDG('ADDRESS' 'MAIL') 31 | ORID 6P 0 TEXT('ORDER NUMBER') 32 | COLHDG('ORD' 'NUM') 33 | EDTCDE(Z) 34 | ODLINE 5P 0 TEXT('ORDER LINE') 35 | COLHDG('ORD' 'LINE') 36 | EDTCDE(Z) 37 | PRID 5P 0 TEXT('PROVIDER ID') 38 | COLHDG('PROVIDER' 'ID') 39 | EDTCDE(Z) 40 | PROVNM 30 TEXT('PROVIDER NAME') 41 | COLHDG('PROVIDER' 'NAME') 42 | PHONE 15 TEXT('PHONE NUMBER') 43 | COLHDG('PHONE' 'NUMBER') 44 | QUANTITY 5 0 TEXT('QUANTITY') 45 | EDTCDE(Z) 46 | COLHDG('QTY') 47 | TOTPRICE 9P 2 TEXT('TOTAL PRICE') 48 | COLHDG('TOTAL' 'PRICE') 49 | EDTCDE(2) 50 | UNITPRICE 7P 2 TEXT('UNIT PRICE') 51 | COLHDG('UNIT' 'PRICE') 52 | EDTCDE(2) 53 | WHID 3 TEXT('WAREHOUSE ID') 54 | COLHDG('WHS' 'ID') 55 | VATCODE 1 TEXT('VAT CODE') 56 | COLHDG('VAT' 'CODE') 57 | DFT('2') 58 | VATRATE 4 2 TEXT('VAT RATE %') 59 | COLHDG('VAT' 'RATE %') 60 | EDTWRD(' , %') 61 | VATNUM 12 TEXT('VAT NUMBER') 62 | COLHDG('VAT' 'NUMBER') 63 | WHNAME 20 TEXT('WAREHOUSE NAME') 64 | COLHDG('WAREHOUSE') 65 | YEAR 4P 0 TEXT('YEAR') 66 | COLHDG('YEAR') 67 | ZIPCOD 10 TEXT('ZIP CODE') 68 | COLHDG('ZIP' 'CODE') 69 | -------------------------------------------------------------------------------- /functionsVAT/.ibmi.json: -------------------------------------------------------------------------------- 1 | { 2 | "version": "0.0.1", 3 | "build": { 4 | "tgtCcsid": "500" 5 | } 6 | } -------------------------------------------------------------------------------- /functionsVAT/Rules.mk: -------------------------------------------------------------------------------- 1 | # Note we build everything to do with this Service Program in this directory 2 | # There is one dependency on the DB reference file SAMREF which is in the 3 | # 'common' directory 4 | 5 | FVAT.SRVPGM: fvat.bnd VAT300.MODULE 6 | FVAT.SRVPGM: TEXT = Functions VAT 7 | FVAT.SRVPGM: private TEXT = Functions VAT 8 | 9 | VAT300.MODULE: vat300.rpgle QPROTOSRC/vat.rpgleinc VATDEF.FILE 10 | VAT300.MODULE: private TEXT := bound into FVAT.SRVPGM 11 | VAT300.MODULE: private DBGVIEW ::= *SOURCE 12 | 13 | VATDEF.FILE: vatdef.pf SAMREF.FILE -------------------------------------------------------------------------------- /functionsVAT/fvat.bnd: -------------------------------------------------------------------------------- 1 | STRPGMEXP PGMLVL(*CURRENT) SIGNATURE('V1') 2 | EXPORT SYMBOL('CLCVAT') 3 | EXPORT SYMBOL('EXISTVATRATE') 4 | EXPORT SYMBOL('GETVATDESC') 5 | EXPORT SYMBOL('GETVATRATE') 6 | ENDPGMEXP 7 | -------------------------------------------------------------------------------- /functionsVAT/vat.rpgleinc: -------------------------------------------------------------------------------- 1 | *============================================= 2 | * Get VAT RATE % 3 | *============================================= 4 | DGetVATRate PR 4P 2 5 | D VATCODE 1A value 6 | *============================================= 7 | * Get VAT description 8 | *============================================= 9 | DGetVATDesc PR 20A 10 | D VATCODE 1A value 11 | *============================================= 12 | * Check VAT Rate 13 | *============================================= 14 | D ExistVATRate PR n 15 | D VATCODE 1A value 16 | *============================================= 17 | * VAT Calculation 18 | *============================================= 19 | D CLCVat PR 9 2 20 | D VATCODE 1 value 21 | D NetValue 9 2 value 22 | *============================================= 23 | * Close VATDEF 24 | *============================================= 25 | D CloseVATDEF PR 26 | -------------------------------------------------------------------------------- /functionsVAT/vat300.rpgle: -------------------------------------------------------------------------------- 1 | **FREE 2 | // ---------------------------------------------------------------------- 3 | // Example conversion of source to RPG Free form 4 | // done by Arcad Transformer RPG 5 | // with a temporary free trial license ( 2 / 10 ) 6 | // submitted by REINHARD 2021-10-21 15.27.02 7 | // (C) Copyright 1992,2015 ARCAD Software 8 | // note : these comments do not appear with a permanent license 9 | // ---------------------------------------------------------------------- 10 | Ctl-Opt nomain; 11 | 12 | Dcl-F VATDEF Keyed usropn; 13 | 14 | /copy VAT 15 | 16 | Dcl-Pr chainVATDEF; 17 | P_VATCODE Char(1) value; 18 | End-Pr; 19 | 20 | Dcl-S K_VATCODE LIKE(VATCODE); 21 | 22 | //============================================= 23 | Dcl-Proc GetVATRate export; 24 | Dcl-Pi GetVATRate Packed(4:2); 25 | P_VATCODE Char(1) value; 26 | End-Pi; 27 | chainVATDEF(P_VATCODE ); 28 | return VATRATE; 29 | End-Proc GetVATRate; 30 | //============================================= 31 | Dcl-Proc GetVATDesc export; 32 | Dcl-Pi GetVATDesc Char(20); 33 | P_VATCODE Char(1) value; 34 | End-Pi; 35 | chainVATDEF(P_VATCODE ); 36 | return VATDESC; 37 | End-Proc GetVATDesc; 38 | 39 | //============================================= 40 | Dcl-Proc ClcVAT export; 41 | Dcl-Pi ClcVAT Packed(9:2); 42 | P_VATCODE Char(1) value; 43 | Net Packed(9:2) value; 44 | End-Pi; 45 | 46 | Dcl-S tot Packed(11:4); 47 | chainVATDEF(P_VATCODE ); 48 | tot = (net * vatrate) / 100; 49 | return %dech(tot : 9 :2) ; 50 | End-Proc ClcVAT; 51 | 52 | //============================================= 53 | Dcl-Proc ExistVATRate export; 54 | Dcl-Pi ExistVATRate Ind; 55 | P_VATCODE Char(1) value; 56 | End-Pi; 57 | chainVATDEF(P_VATCODE ); 58 | return %found(VATDEF) and VATDEL <> 'X'; 59 | End-Proc ExistVATRate; 60 | 61 | Dcl-Proc chainVATDEF; 62 | Dcl-Pi chainVATDEF; 63 | P_VATCODE Char(1) value; 64 | End-Pi; 65 | if not %open(VATDEF); 66 | open VATDEF; 67 | endif; 68 | if P_VATCODE <> VATCODE; 69 | K_VATCODE = P_VATCODE; 70 | clear *all FVAT; 71 | chain K_VATCODE VATDEF; 72 | endif; 73 | End-Proc chainVATDEF; 74 | 75 | Dcl-Proc closeVATDEF; 76 | Dcl-Pi closeVATDEF End-Pi; 77 | if %open(VATDEF); 78 | close VATDEF; 79 | endif; 80 | End-Proc closeVATDEF; 81 | 82 | -------------------------------------------------------------------------------- /functionsVAT/vatdef.pf: -------------------------------------------------------------------------------- 1 | REF(SAMREF) 2 | A R FVAT 3 | A VATCODE R 4 | A VATRATE R 5 | A VATDESC 20 6 | A VATCREA L TEXT('CREATION DATE') 7 | A COLHDG('CREAETION' 'DATE') 8 | A VATMOD Z TEXT('LAST MODIFICATION') 9 | A COLHDG('LAST' 'MODIFICATION') 10 | A VATMODID 10 TEXT('LAS MOD BY') 11 | A COLHDG('LAST' 'MODIF.' 'BY') 12 | A VATDEL R REFFLD(DLCODE) 13 | A K VATCODE 14 | -------------------------------------------------------------------------------- /globalization/CHS/.ibmi.json: -------------------------------------------------------------------------------- 1 | { 2 | "version": "0.0.1", 3 | "build": { 4 | "tgtCcsid": "935" 5 | } 6 | } -------------------------------------------------------------------------------- /globalization/CHS/CHS.RPGLE: -------------------------------------------------------------------------------- 1 | 即 D/DEFINE DEF1 should not appear in outline view 2 | D fld2 s 20A ccsid(*JOBRUNMIX) 3 | 即 dcl-s fld3 char(30) ; // prompt before dcl-s should see all dcl-xx opcodes 4 | C '即可加快进'cat '即' fld2 CMT即 5 | 加 fld2 = '即加'; // hover on fld2 should work and should be seen as a reference 6 | 加 //<- prompting here should see all calc opcodes 7 | fld3 = fld2; // formatting files should not indent/outdents anything 8 | C SETON LR -------------------------------------------------------------------------------- /globalization/CHS/Rules.mk: -------------------------------------------------------------------------------- 1 | CHS.MODULE: CHS.RPGLE 2 | CHS.PGM: CHS.MODULE -------------------------------------------------------------------------------- /globalization/DEU/.ibmi.json: -------------------------------------------------------------------------------- 1 | { 2 | "version": "0.0.1", 3 | "build": { 4 | "tgtCcsid": "273" 5 | } 6 | } -------------------------------------------------------------------------------- /globalization/DEU/DEU.RPGLE: -------------------------------------------------------------------------------- 1 | **free 2 | // German special characters in variables name 3 | dcl-s §var ind; // begin with \u00a7 paragraph symbol 4 | §var = *on; 5 | // German umlaut character in a literal 6 | dsply 'Prüfexemplar'; 7 | return; -------------------------------------------------------------------------------- /globalization/DEU/Däöü.RPGLE: -------------------------------------------------------------------------------- 1 | **free 2 | //Testing NLS chars in filenames -------------------------------------------------------------------------------- /globalization/DEU/Rules.mk: -------------------------------------------------------------------------------- 1 | DEU.MODULE: DEU.RPGLE 2 | DEU.PGM: DEU.MODULE -------------------------------------------------------------------------------- /globalization/HEB/.ibmi.json: -------------------------------------------------------------------------------- 1 | { 2 | "version": "0.0.1", 3 | "build": { 4 | "tgtCcsid": "424" 5 | } 6 | } -------------------------------------------------------------------------------- /globalization/HEB/Rules.mk: -------------------------------------------------------------------------------- 1 | HEB.PGM: heb.pgm.rpgle -------------------------------------------------------------------------------- /globalization/HEB/heb.pgm.rpgle: -------------------------------------------------------------------------------- 1 | ‎ //זו דוגמא להערה עם עברית : remark 2 | dcl-s aString char(50); 3 | aString = 'מלל בעברית'; 4 | aString = 'מלל נוסף בעברית'; //remak with עברית 5 | aString = 'english and עברית and signs #%* וגם מספרים 12321'; //remark with עברית 6 | return; -------------------------------------------------------------------------------- /globalization/Rules.mk: -------------------------------------------------------------------------------- 1 | SUBDIRS = CHS DEU HEB 2 | -------------------------------------------------------------------------------- /includes/included.clle: -------------------------------------------------------------------------------- 1 | DCL VAR(&CUID) TYPE(*DEC) LEN(5 0) -------------------------------------------------------------------------------- /iproj.json: -------------------------------------------------------------------------------- 1 | { 2 | "version": "0.0.1", 3 | "description": "SAMPLE PROJECT", 4 | "objlib": "&lib1", 5 | "curlib": "&lib1", 6 | "includePath": [ 7 | "includes", 8 | "QPROTOSRC" 9 | ], 10 | "preUsrlibl": [ 11 | "&lib1" 12 | ], 13 | "postUsrlibl": [], 14 | "setIBMiEnvCmd": [], 15 | "repository": "https://github.com/edmundreinhardt/bob-recursive-example.git", 16 | "compileCommand": "/QOpenSys/pkgs/bin/makei c -f {filename}", 17 | "buildCommand": "/QOpenSys/pkgs/bin/makei build" 18 | } --------------------------------------------------------------------------------