Retrieve Display File Description (QDFRTVFD)
Introduction
I based my DSM logic on this example.[1] Dynamic screen example with FTP Thanks to Scott Klement [2] for posting the best samples of code on the web to play with!
I based my code for the QDFRTVFD API on the example from Scott Klement.
Thank you Scott. [3]
My code looks very different to Scotts work. But without Scotts example I would not have got anywhere.
The key to understanding the API is that on any one iteration though the data structures ONLY ONE FIELDS INFORMATION AT A TIME is retrieved.
The DSPINFO program is not complete.
But it does get enough info to show a layout.
Much remains to be done; a partial list is, WINDOWS, SUBFILES, REFERENCES,ATTRIBUTES etc etc etc.
I am now amazed and humbled by the work of the IBM programmers that set up such a thing as an external display file.
I found IBM documentation both detailed and frustrating in particular how to set the pointers to the next iteration of a DS.
And there is a very devious bit on the indexes WDFWRRDX WDFWNMEI you must use these and never assume the fields follow some sequence.
I am having trouble with the retrieval of attributes (file , record and field)
I get a weird result with edit codes.
#FLDEDT = '�£ ��¥¥^:�¥¥^:�¥¥ ' for 1 61TIME EDTWRD(' : : ') EVAL #FldEdt :x 00000 03B14003 03B2B2B0 7A03B2B2 B07A03B2 - .£ ..¥¥^:.¥¥^:.¥ 00010 B2404040 ........ ........ ........ - ¥ ............
I found the IBM code for the API in QSYSINC too arcane to use as is.
However it was a good start and after removing the comments and renaming fields to match the IBM docs of QDFRTVFD I used the result.
I also reformatted some of the DS to use the OVERLAY notation.
Also there are many fields missing in the QSYSINC of the type like WDFFRC
==== example of missing field === Row-Column Table (QDFFRCTB) Row-column table, one table per screen size. Offset Bit Type Variable Name Dec Hex 0 0 CHAR(1) WDFFFRRO 1 1 CHAR(1) WDFFFRCO 2 2 CHAR(1) WDFFTORO 3 3 CHAR(1) WDFFTOCO 4 4 CHAR(1) WDFFRBIT 4 4 0 BIT(1) WDFFMDF 4 4 1 BIT(1) WDFFFRC1 4 4 2 BIT(1) WDFFTRAT 4 4 3 BIT(1) WDFFR1C1 4 4 4 BIT(1) WDFFR2C1 4 4 5 BIT(3) * 5 5 CHAR(1) * 6 6 CHAR(*) WDFFRC
DSPINFO Svc Pgm
This service program uses the QDFRTVFD API to pass back the Display file Fields and Constants via a MODS.
The amount of info returned is very rudimentary compared with what could be returned.
usage parm sent $FilQul = $Fil + $lib; parms returned #GotFlds -- Number of fields and constants #FldDtaDS -- MODS with field/constant info *IN10 = RTVFLDS ($FilQul : #GotFlds : FldDtaDS); D FldDtaDS DS occurs(1000) D #FmtNam 10A D #FldNam 10A D #FldLen 5I 0 D #FldPlen 5I 0 D #FldDec 1 D #FldIO 1 D #FldAtr 1 D #FldDTUS 1 D #FldEdt 20A D #FldRow 10I 0 D #FldCol 10I 0 D #FldCom 1000A varying
*------------------------------------------------------------------- * = Service program... DspFInfo= * = Description....... Retrieve display file information routines= *------------------------------------------------------------------- * CRTSQLRPGI OBJ(urlib/DSPFINFO) * SRCFILE(urlib/ursrcfile) * SRCMBR(DSPFINFO) * OBJTYPE(*MODULE) REPLACE(*yes) * * CRTSRVPGM SRVPGM(urlib/DSPFINFO) * MODULE(urlib/DSPFINFO) * EXPORT(*ALL) * * H NoMain *------------------------------------------------------------------- * - RtvDspFDesc - Retrieve display file description (QDFRTVFD API)- *------------------------------------------------------------------- D RtvDspFDesc PR ExtPgm( 'QDFRTVFD' ) D 8 D 10I 0 Const D 8 Const D 20 Const D 272 D RtvFlds PR N D QDspFil 20A Value D QNumFlds 10I 0 D QFlddta Like(FldDtaDS) D FldDtaDS DS Based (p_FldDtaDS) occurs(1000) D #FmtNam 10A D #FldNam 10A D #FldLen 5I 0 D #FldPlen 5I 0 D #FldDec 1 D #FldIO 1 D #FldAtr 1 D #FldDTUS 1 D #FldEdt 20A D #FldRow 10I 0 D #FldCol 10I 0 D #FldCom 1000A varying *---------------------------------------------------------------* * Retrieve Display File Fields * *---------------------------------------------------------------* P RtvFlds B Export D RtvFlds PI Like(LglTyp) D QDspFil Like( QNamTyp ) Value D Numflds 10I 0 D FldDta Like(FldDtaDS) *------------------------------------------------------------------- * - Base - *------------------------------------------------------------------- D QDFFBASE DS Based( p_QDFFBASE) qualified D WDFFINFO 5I 0 Overlay( QDFFBASE : 9 ) D WDFFRCS 5I 0 Overlay( QDFFBASE : 11 ) D WDFFSCR 5I 0 Overlay( QDFFBASE : 14 ) D WDFFSCRS 1A Overlay( QDFFBASE : 20 ) * p_QDFFSCRA = %addr( QDFFBASE.WDFFSCRS) first * p_QDFFSCRA = P_QDFFSCRA + %size(QDFFSCRA) * n next DQDFFSCRA DS Based( p_QDFFSCRA ) qualified D WDFFSCIA 1 1 D WDFRVED2 2 5 DQDFFSSEQ DS Based( p_QDFFSSEQ ) qualified D WDFFFSST 1 256 D WDFFFSSC 257 260U 0 D WDFFFSSN 261 270 D WDFFFSSL 271 280 D WDFBITS00 281 282 D WDFRVED4 283 308 *------------------------------------------------------------------- * - File Header - * p_QDFFINFO = p_QDFFBASE + QDFFBASE.WDFFINFO *------------------------------------------------------------------- D QDFFINFO DS Based( p_QDFFINFO) qualified D WDFFDFLO 10I 0 Overlay( QDFFINFO : 1 ) D WDFFWUOF 10I 0 Overlay( QDFFINFO : 5 ) D WDFFFMWU 10I 0 Overlay( QDFFINFO : 9 ) D WDFFXDOF 5I 0 Overlay( QDFFINFO : 35) D ZDFF 1 50A *------------------------------------------------------------------- * - File Where Used - * p_QDFWFLEI = p_QDFFINFO + QDFFINFO.WDFFWUOF *------------------------------------------------------------------- D QDFWFLEI DS Based( p_QDFWFLEI) qualified D WDFWXLEN 5I 0 Overlay( QDFWFLEI : 1 ) D WDFWXOKW 5I 0 Overlay( QDFWFLEI : 3 ) D WDFWWULN 10I 0 Overlay( QDFWFLEI : 5 ) D WDFWNTBO 10I 0 Overlay( QDFWFLEI : 9 ) D WDFFWXIN 5I 0 Overlay( QDFWFLEI : 12) // pointer D WDFWINDX 1A Overlay( QDFWFLEI : 19) *------------------------------------------------------------------- * - File Dev Dept - * p_QDFFDPDD = p_QDFFINFO + QDFFINFO.WDFFXDOF *------------------------------------------------------------------- D QDFFDPDD DS Based( p_QDFFDPDD) qualified D WDFFFKWD 5I 0 Overlay( QDFFDPDD : 9 ) D WDFFSHB1 5I 0 Overlay( QDFFDPDD : 13) D WDFFSHRA 5I 0 Overlay( QDFFDPDD : 16) D WDFFCKY1 5I 0 Overlay( QDFFDPDD : 17) D WDFFCKY2 5I 0 Overlay( QDFFDPDD : 18) D WDFFCKY3 5I 0 Overlay( QDFFDPDD : 19) D WDFFMKWD 5I 0 Overlay( QDFFDPDD : 20) D WDFFMKW2 5I 0 Overlay( QDFFDPDD : 21) D WDFFXDOC 5I 0 Overlay( QDFFDPDD : 25) *------------------------------------------------------------------- * - Name Table- * p_QDFFNTBL = p_QDFWFLEI + QDFWFLEI.WDFWNTBO *------------------------------------------------------------------- D QDFFNTBL DS Based( p_QDFFNTBL) qualified D WDFFNMS 10I 0 Overlay( QDFFNTBL : 1 ) // pointer to array char(10) D WDFFNMES 1A // Field Name D QDFFNTB DS Based( p_QDFFNTB ) qualified D WDFFNAM 10A *------------------------------------------------------------------- * - Record Where Used - * p_QDFWRCDI = p_QDFWFLEI + QDFWFLEI.WDFWXLEN first *------------------------------------------------------------------- D QDFWRCDI DS Based( p_QDFWRCDI ) qualified D WDFWRLEN 5I 0 Overlay( QDFWRCDI : 1 ) D WDFWROKW 5I 0 Overlay( QDFWRCDI : 3 ) D WDFWNXTR 10I 0 Overlay( QDFWRCDI : 5 ) D WDFWRIN 5I 0 Overlay( QDFWRCDI : 9 ) // pointer to indicator table D WDFWINDR 1A Overlay( QDFWRCDI : 13) *------------------------------------------------------------------- * - Record Format Table- * p_QDFARFTE = p_QDFFINFO + QDFFINFO.WDFFDFLO first * p_QDFARFTE = p_QDFARFTE + %Len( QDFARFTE ) next * alt p_QDFARFTE = p_QDFFINFO + QDFFINFO.WDFFDFLO + * (%size(QDFARFTE) * x) *------------------------------------------------------------------- D QDFARFTE DS Based ( p_QDFARFTE ) qualified D WDFARFNM 10 Overlay( QDFARFTE : 1 ) D WDFARCND 5I 0 Overlay( QDFARFTE : 11 ) D WDFARFOF 10I 0 Overlay( QDFARFTE : 13 ) DQDFFSEQT DS Based ( p_QDFFSEQT ) qualified D WDFFFSEQ 1 13 D WDFVED17 14 16 *------------------------------------------------------------------- * - Record Header - * p_QDFFRINF = p_QDFFINFO + QDFARFTE.WDFARFOF *------------------------------------------------------------------- D QDFFRINF DS Based ( p_QDFFRINF ) qualified D WDFFRDDO 10I 0 Overlay( QDFFRINF : 1 ) D WDFFOFIT 10I 0 Overlay( QDFFRINF : 5 ) D WDFFSTBO 10I 0 Overlay( QDFFRINF : 9 ) D WDFFRFLG1 1A Overlay( QDFFRINF : 13 ) D WDFFRFLG2 1A Overlay( QDFFRINF : 14 ) D WDFFFLD 5I 0 Overlay( QDFFRINF : 17 ) D WDFFINDO 5I 0 Overlay( QDFFRINF : 23 ) D WDFFRAOF 5I 0 Overlay( QDFFRINF : 29 ) *------------------------------------------------------------------- * Display-Record-Level Device-Dependent * p_QDFFXRDP = p_QDFFRINF + QDFFRDPD.WDFFXRDO DQDFFXRDP DS Based (p_QDFFXRDP ) qualified D WDFFFOTO 1 4B 0 D WDFFNRCO 5 8B 0 D WDFVED33 9 12 D WDFFSEGS 13 14B 0 D WDFVED34 15 16 D WDFHCTLO 17 18B 0 D WDFVED35 19 24 D DQDFFSFCR DS Based (p_QDFFSFCR ) qualified D WDFFSFLG 1 34 D WDFFSFEN 35 35 D WDFFSFDR 36 36 D WDFBITS19 37 37 D WDFBITS20 38 38 D WDFFSFPQ 39 40B 0 D WDFFSFVL 41 42B 0 D WDFFSFVO 43 44B 0 D WDFFSFFI 45 46B 0 D WDFFFSFL01 47 48B 0 D WDFFFSFO 49 50B 0 D WDFXTOFF 51 52B 0 D WDFBITS21 53 53 D WDFVED37 54 54 D WDFFSFPM 55 55 D DQDFSFSRU DS Based (p_QDFSFSRU ) qualified D WDFVED39 1 1 D WDFFSFSR 2 2 DQDFSFERU DS Based (p_QDFSFERU ) qualified D WDFVED40 1 1 D WDFFSFER 2 2 DQDFSFH2U DS Based (p_QDFSFH2U ) qualified D WDFFSFH1 1 2B 0 D WDFFSFH2 3 4B 0 D DQDFCREXT DS Based (p_QDFCREXT ) qualified D WDFCRLLO 1 2B 0 D WDFIZSFO 3 4B 0 D WDFELOFF 5 6B 0 D WDFELCH1 7 7 D WDFELCH2 8 8 D WDFVED42 9 16 *------------------------------------------------------------------- * - Record Device-Dependent (QDFFRDPD) * p_QDFFRDPD = p_QDFFRINF + WDFFRAOF *------------------------------------------------------------------- D QDFFRDPD DS Based (p_QDFFRDPD ) qualified D WDFFDRCO 10I 0 Overlay( QDFFRDPD : 1 ) D WDFFINCP 5I 0 Overlay( QDFFRDPD : 5 ) D WDFFIBF 5I 0 Overlay( QDFFRDPD : 7 ) D WDFFOIS 5I 0 Overlay( QDFFRDPD : 9 ) D WDFACKYS 4A Overlay( QDFFRDPD : 13 ) D WDFFPUTK 2A Overlay( QDFFRDPD : 17 ) D WDFFGETK 2A Overlay( QDFFRDPD : 19 ) D WDFFERRM 5I 0 Overlay( QDFFRDPD : 21 ) D WDFFBITS 1A Overlay( QDFFRDPD : 23 ) D WDFFBITF 1A Overlay( QDFFRDPD : 24 ) D WDFFCGRI 5I 0 Overlay( QDFFRDPD : 25 ) D WDFFHFLG 2A Overlay( QDFFRDPD : 27 ) D WDFFXRDO 5I 0 Overlay( QDFFRDPD : 29 ) D WDFFRDOC 5I 0 Overlay( QDFFRDPD : 33 ) *------------------------------------------------------------------- * - Row Column Table - * p_QDFFRCTB = p_QDFFRINF + WDFFDRCO * SizeIndex = 0 to WDFFSCR -1 *------------------------------------------------------------------- D QDFFRCTB DS Based ( p_QDFFRCTB) qualified D WDFFFRRO 1A Overlay( QDFFRCTB : 1 ) D WDFFFRCO 1A Overlay( QDFFRCTB : 2 ) D WDFFTORO 1A Overlay( QDFFRCTB : 3 ) D WDFFTOCO 1A Overlay( QDFFRCTB : 4 ) D WDFFRBIT 1A Overlay( QDFFRCTB : 5 ) D WDFFRC 1A Overlay( QDFFRCTB : 7 ) *------------------------------------------------------------------- * - Row Column Table Entries - * p_QDFFRCTE = %addr(QDFFRCTB.WDFFRC) first * p_QDFFRCTE = p_QDFFRCTE + %size(QDFFRCTE) next D QDFFRCTE DS Based ( p_QDFFRCTE) qualified D WDFFSROW 1 1A D WDFFSCOL 2 2A *------------------------------------------------------------------- * - Field Where Used - * p_QDFWFLDI = p_QDFWRCDI + QDFWRCDI.WDFWRLEN first * p_QDFWFLDI = p_QDFWFLDI + WDFWFLDL next *------------------------------------------------------------------- D QDFWFLDI DS Based ( p_QDFWFLDI ) qualified D WDFWFLDL 5I 0 Overlay( QDFWFLDI : 1 ) D WDFWFOKW 5I 0 Overlay( QDFWFLDI : 3 ) D WDFWRRDX 5I 0 Overlay( QDFWFLDI : 5 ) // index into Field Name Table p_QDFFNTBL D WDFWNMEI 10I 0 Overlay( QDFWFLDI : 7 ) D WDFWLFLD 5I 0 Overlay( QDFWFLDI : 11 ) D WDFWFFLG 1A Overlay( QDFWFLDI : 13 ) *------------------------------------------------------------------- * - Field Index - * QDFFRINF is at variable WDFFOFIT in QDFFRINF. *------------------------------------------------------------------- D QDFFFITB DS Based ( p_QDFFFITB ) qualified D WDFFFOFS 10I 0 Overlay( QDFFFITB : 1 ) D WDFFSELI 5I 0 Overlay( QDFFFITB : 5 ) D WDFFDLEN 5I 0 Overlay( QDFFFITB : 7 ) *------------------------------------------------------------------- *------------------------------------------------------------------- * - Constant Field Header - * p_QDFFFCON = WDFFFTBE *------------------------------------------------------------------- D QDFFFCON DS Based ( p_QDFFFCON ) qualified D WDFFFAOC 5I 0 Overlay( QDFFFCON : 3 ) *------------------------------------------------------------------- * - Named Field Header - * p_QDFFFNAM = WDFFFTBE *------------------------------------------------------------------- D QDFFFNAM DS Based ( p_QDFFFNAM ) qualified D WDFFINPO 5I 0 Overlay( QDFFFNAM : 1 ) D WDFFOUTO 5I 0 Overlay( QDFFFNAM : 3 ) D WDFFPLEN 5I 0 Overlay( QDFFFNAM : 5 ) D WDFFDEC 1A Overlay( QDFFFNAM : 7 ) D WDFFKBDT 1A Overlay( QDFFFNAM : 8 ) D WDFFFAOF 5I 0 Overlay( QDFFFNAM : 11 ) *------------------------------------------------------------------- * - Field Header * p_QDFFFINF = p_QDFFRINF + WDFFFOFS *------------------------------------------------------------------- D QDFFFINF DS Based ( p_QDFFFINF ) qualified D WDFFFLEN 1A Overlay( QDFFFINF : 1 ) D WDFFFIOA 1A Overlay( QDFFFINF : 3 ) D WDFFBFLG 1A Overlay( QDFFFINF : 4 ) D WDFFFBIT 1A Overlay( QDFFFINF : 5 ) // pointer to QDFFFCON or QDFFFNAM D WDFFFTBE 1A Overlay( QDFFFINF : 7 ) *------------------------------------------------------------------- * - Field Dev Dept * p_QDFFFDPD = p_QDFFFINF + WDFFFAOF named * p_QDFFFDPD = p_QDFFFINF + WDFFFAOC constant *------------------------------------------------------------------- D QDFFFDPD DS Based ( p_QDFFFDPD ) qualified D WDFFFLGS 1A Overlay( QDFFFDPD : 1 ) D WDFFSA 1A Overlay( QDFFFDPD : 2 ) D WDFFXFDO 5I 0 Overlay( QDFFFDPD : 3 ) D WDFFFDOC 5I 0 Overlay( QDFFFDPD : 5 ) // pointer D WDFFFICE 1A Overlay( QDFFFDPD : 7 ) *------------------------------------------------------------------- * - Input-Capable Display Field-Level Device-Dep * p_QDFFFDIC = WDFFFICE *------------------------------------------------------------------- D QDFFFDIC DS Based ( p_QDFFFDIC ) qualified D WDFFFWFW 2A Overlay( QDFFFDIC : 1 ) D WDFFSSKW 1A Overlay( QDFFFDIC : 3 ) D WDFFCHKB 1A Overlay( QDFFFDIC : 4 ) *------------------------------------------------------------------- * - Field-Dependent Extension - * p_QDFFXFDP = p_QDFFFINF + WDFFXFDO *------------------------------------------------------------------- D QDFFXFDP DS Based ( p_QDFFXFDP ) qualified D WDFFKFLG 2A Overlay( QDFFXFDP : 1 ) D WDFFFLDINX 5I 0 Overlay( QDFFXFDP : 3 ) D WDFFXLFLGS 1A Overlay( QDFFXFDP : 4 ) // this is a BIN 16 D WDFF_UCS2_ 2A Overlay( QDFFXFDP : 6 ) *------------------------------------------------------------------- * - Keyword Category Displacement * file p_QDFFCOSA = p_QDFFINFO + WDFFXDOC * record p_QDFFCOSA = p_QDFFRINF + WDFFRDOC * field p_QDFFCOSA = p_QDFFFINF + WDFFFDOC *------------------------------------------------------------------- D QDFFCOSA DS Based ( p_QDFFCOSA ) qualified D WDFFCCT 5I 0 Overlay( QDFFCOSA : 1 ) // pointer D WDFFCCOS 1A Overlay( QDFFCOSA : 3 ) *------------------------------------------------------------------- * - Keyword Category Displacement String Entry * p_QDFFCCOA = %addr(WDFFCCOS) *------------------------------------------------------------------- D QDFFCCOA DS Based ( p_QDFFCCOA ) qualified D WDFFCAID 1A Overlay( QDFFCCOA : 1 ) D WDFFCAOF 5I 0 Overlay( QDFFCCOA : 2 ) *------------------------------------------------------------------- * - Subfile Control Record- *------------------------------------------------------------------- DQDFFSFHR DS Based (p_QDFFSFHR ) qualified D WDFFSFSZ 1 2B 0 D WDFFSFPG 3 4B 0 D WDFVED38 5 6 D WDFFFSFT 7 8B 0 D WDFSFR1U 9 10 D WDFFSFR1 9 10B 0 D WDFVED3900 9 9 D WDFFSFSR00 10 10 D WDFSFR2U 11 12 D WDFFSFR2 11 12B 0 D WDFVED4000 11 11 D WDFFSFER00 12 12 D WDFSFLNU 13 16 D WDFFSFLN 13 16 D WDFFSFH100 13 14B 0 D WDFFSFH200 15 16B 0 D WDFFFSFF 17 18B 0 D WDFVED41 19 24 DQDFKFILK DS Based (p_QDFKFILK ) qualified D WDFFKFIL 5I 0 Overlay( QDFKFILK : 1 ) D WDFKFILE 1A Overlay( QDFKFILK : 3 ) DQDFKFLPM DS Based (p_QDFKFLPM ) qualified D WDFKFLID 1 Overlay( QDFKFLPM : 1 ) D WDFKFLST 5I 0 Overlay( QDFKFLPM : 2 ) D WDFKFLRS 5I 0 Overlay( QDFKFLPM : 4 ) D WDFFKFLP 5I 0 Overlay( QDFKFLPM : 6 ) D WDFKFLEX 1A Overlay( QDFKFLPM : 8 ) DQDFKFLPP DS Based (p_QDFKFLPP ) qualified D WDFKFLLN 5I 0 Overlay( QDFKFLPP : 1 ) D WDFKFLNM 1A Overlay( QDFKFLPP : 3 ) DQDFKFLSZ DS Based (p_QDFKFLSZ ) qualified D WDFKFLML 1 2B 0 D WDFVED57 3 6 DQDFKICVP DS Based (p_QDFKICVP ) qualified D WDFKICVN 1 2B 0 D WDFKICVK 3 4B 0 D WDFKICVT 5 6B 0 DQDFKHARD DS Based (p_QDFKHARD ) qualified D WDFKHRFM 1 10 D WDFKHFIL 11 20 D WDFKHLIB 21 30 DQDFKHXPS DS Based (p_QDFKHXPS ) qualified D WDFKHXHG 1 10 D WDFKHXHL 11 20 D WDFKHXML 21 22B 0 DQDFKHDOC DS Based (p_QDFKHDOC ) qualified D WDFKHDLA 1 10 D WDFKHDDO 11 22 D WDFKHDFL 23 24B 0 DQDFKSIDX DS Based (p_QDFKSIDX ) qualified D WDFKSIOB 1 10 D WDFKSILB 11 20 DQDFKFALX DS Based (p_QDFKFALX ) qualified D WDFFKALT 1 2B 0 DQDFKFALK DS Based (p_QDFKFALK ) qualified D WDFKANME 1 10 D WDFKAINX 11 12B 0 DQDFKESFL DS Based (p_QDFKESFL ) qualified D WDFKESCR 1 10 DQDFKBODR DS Based (p_QDFKBODR ) qualified D WDFKCLOR 1 1 D WDFKDATR 2 2 D WDFKCHRS 3 10 DQDFKCKKW DS Based (p_QDFKCKKW ) qualified D WDFFKCKS 1 2B 0 D WDFKCKCM 3 3 DQDFKCKKE DS Based (p_QDFKCKKE ) qualified D WDFKCKID 1 1 D WDFKCKIN 2 3B 0 D WDFKCKRS 4 5B 0 D WDFKCKMA 6 9 DQDFKOVRR DS Based (p_QDFKOVRR ) qualified D WDFFKOLS 1 2B 0 DQDFKOVRE DS Based (p_QDFKOVRE ) qualified D WDFKOLAD 1 1 D WDFKOLAN 2 3B 0 DQDFKOVRP DS Based (p_QDFKOVRP ) qualified D WDFKOLID 1 1 D WDFKOLIN 2 3B 0 DQDFKOLER DS Based (p_QDFKOLER ) qualified D WDFFKOLE 1 2B 0 DQDFKOLCL DS Based (p_QDFKOLCL ) qualified D WDFFKOLC 1 2B 0 D WDFKOLCN 3 4B 0 DQDFKMSRL DS Based (p_QDFKMSRL ) qualified D WDFFKMSS 5I 0 Overlay( QDFKMSRL : 1 ) D WDFKMSKW 1A Overlay( QDFKMSRL : 3 ) DQDFKMSAP DS Based (p_QDFKMSAP ) qualified D WDFKMSAD 1 1 D WDFKMSAN 2 3B 0 DQDFKMSCP DS Based (p_QDFKMSCP ) qualified D WDFKMSID 1 1 D WDFKMSIN 2 3B 0 DQDFKMSK1 DS Based (p_QDFKMSK1 ) qualified D WDFKMSLC 1 2B 0 D WDFVED58 3 3 D WDFKMSRW 4 5B 0 D WDFKMSCL 6 7B 0 D WDFKMSFA 8 11B 0 D WDFKMSFB 12 15B 0 DQDFKMSK2 DS Based (p_QDFKMSK2 ) qualified D WDFKMSLN 1 2B 0 DQDFKMSK3 DS Based (p_QDFKMSK3 ) qualified D WDFKMSDM 1 2B 0 DQDFMSCLN DS Based (p_QDFMSCLN ) qualified D WDFSCROU 1 2 D WDFMSCRO 1 2B 0 D WDFKRCLR 1 2B 0 D WDFSCFOU 3 4 D WDFMSCFO 3 4B 0 D WDFKRCLC 3 4B 0 D WDFSCLOU 5 6 D WDFMSCLO 5 6B 0 D WDFKCLWR 5 6B 0 D WDFRCLWC 7 8B 0 D WDFCTYPE 9 9 D WDFBITS32 10 10 DQDFMBDSP DS Based (p_QDFMBDSP ) qualified D WDFBDRCN 1 10 D WDFBDCFO 11 12B 0 D WDFBDPIO 13 14B 0 DQDFK0BPR DS Based (p_QDFK0BPR ) qualified D WDF0BPCT 1 2B 0 DQDF0BXWP DS Based (p_QDF0BXWP ) qualified D WDF0BPID 1 1 D WDF0BPIN 2 3B 0 D WDF0BPLN 4 5B 0 DQDFBGATR DS Based (p_QDFBGATR ) qualified D WDF0BCLR 1 1 D WDFVED59 2 2 D WDFK0BLT 3 3 D WDFVED60 4 4 DQDFBKPRM DS Based (p_QDFBKPRM ) qualified D WDFBKNAM 1 8 DQDFKMRPR DS Based (p_QDFKMRPR ) qualified D WDFFKRPS 1 2B 0 DQDFKMRWP DS Based (p_QDFKMRWP ) qualified D WDFKMPID 1 1 D WDFKMPIN 2 3B 0 D WDFKMPLN 4 5B 0 DQDFKHSTR DS Based (p_QDFKHSTR ) qualified D WDFWDFKH 1 2B 0 DQDFKHPRM DS Based (p_QDFKHPRM ) qualified D WDFKHOFS 1 2B 0 D WDFBITS33 3 4 D WDFKHSRO 5 6B 0 D WDFKHCRD 7 8B 0 D WDFKHCBY 9 10B 0 D WDFKHARO 11 12B 0 D WDFKHCEX 13 14B 0 D WDFVED62 15 17 DQDFKHNMS DS Based (p_QDFKHNMS ) qualified D WDFKHRCD 1 10 D WDFKHFLE 11 20 D WDFKHRLB 21 30 DQDFKHPS DS Based (p_QDFKHPS ) qualified D WDFKHPNN 1 10 D WDFKHPLB 11 20 D WDFKHMLN 21 22B 0 DQDFKHRDC DS Based (p_QDFKHRDC ) qualified D WDFKHRLA 1 10 D WDFKHRDO 11 22 D WDFKHRFL 23 24B 0 DQDFKHARA DS Based (p_QDFKHARA ) qualified D WDFKHFRO 1 1 D WDFKHFCO 2 2 D WDFKHTRO 3 3 D WDFKHTCO 4 4 DQDFKHARX DS Based (p_QDFKHARX ) qualified D WDFBITS34 1 1 D WDFHFLDI 2 3B 0 D WDFHCHID 4 5 DQDFKHSEQ DS Based (p_QDFKHSEQ ) qualified D WDFKHSGN 1 10 D WDFFKHSS 11 12B 0 D WDFKHSIF 13 14B 0 D WDFKHSIL 15 16B 0 D WDFKHSIN 17 18B 0 D WDFKHSIP 19 20B 0 DQDFKPRTR DS Based (p_QDFKPRTR ) qualified D WDFKRLRS 1 2B 0 D WDFFKRLP 3 4B 0 DQDFKPPRM DS Based (p_QDFKPPRM ) qualified D WDFKPLEN 1 2B 0 DQDFKBRDR DS Based (p_QDFKBRDR ) qualified D WDFKCOLR 1 1 D WDFKDSPA 2 2 D WDFKCHAR 3 10 DQDFKLINU DS Based (p_QDFKLINU ) qualified D WDFFKLIN 1 2B 0 D WDFFKPOS 3 4B 0 D WDFKLINW 5 6B 0 D WDFKPOSW 7 8B 0 D WDFVED66 9 10 DQDFKWDTA DS Based (p_QDFKWDTA ) qualified D WDFBITS35 1 2 D WDFWNAMU 3 12 D WDFKWNAM 3 12 D WDFFKLIN00 3 4B 0 D WDFFKPOS00 5 6B 0 D WDFKLINW00 7 8B 0 D WDFKPOSW00 9 10B 0 D WDFVED6600 11 12 DQDFOLORU DS Based (p_QDFOLORU ) qualified D WDFVED68 1 1 D WDFCOLOR 2 2 DQDFDSPAU DS Based (p_QDFDSPAU ) qualified D WDFVED69 1 1 D WDFTDSPA 2 2 DQDFLIGNU DS Based (p_QDFLIGNU ) qualified D WDFVED70 1 1 D WDFALIGN 2 2 DQDFDWTTL DS Based (p_QDFDWTTL ) qualified D WDFDWOVL 1 5 D WDFBITS36 6 6 D WDFLRPFU 7 8 D WDFCLRPF 7 8B 0 D WDFVED6800 7 7 D WDFCOLOR00 8 8 D WDFSPPFU 9 10 D WDFDSPPF 9 10B 0 D WDFVED6900 9 9 D WDFTDSPA00 10 10 D WDFALGNU 11 12 D WDFTALGN 11 12B 0 D WDFVED7000 11 11 D WDFALIGN00 12 12 D WDFTTXTO 13 14B 0 D WDFTTXTL 15 16B 0 D WDFVED71 17 26 DQDFKMB DS Based (p_QDFKMB ) qualified D WDFBITS37 1 1 D WDFFIRST 2 2 D WDFECOND 3 3 D WDFMBAID 4 4 DQDFKSCSF DS Based (p_QDFKSCSF ) qualified D WDFFKSCS 1 2B 0 DQDFKSCCP DS Based (p_QDFKSCCP ) qualified D WDFKSCID 1 1 D WDFKSCIN 2 3B 0 DQDFKSCSM DS Based (p_QDFKSCSM ) qualified D WDFKSCRS 1 2B 0 D WDFKSCTY 3 3 D WDFKSCLN 4 5B 0 DQDFKSCSI DS Based (p_QDFKSCSI ) qualified D WDFKSCMI 1 7 D WDFKSCMF 8 17 D WDFKSCML 18 27 D WDFKSCDL 28 29B 0 D WDFKSCMO 30 31B 0 DQDFKSFLM DS Based (p_QDFKSFLM ) qualified D WDFKMORE 1 12 D WDFKBOTT 13 24 DQDFKSFLS DS Based (p_QDFKSFLS ) qualified D WDFNDSPM 1 1 D WDFLMORE 2 13 D WDFLBOTT 14 25 DQDFSRRRN DS Based (p_QDFSRRRN ) qualified D WDFCSRNO 1 2B 0 DQDFKMODE DS Based (p_QDFKMODE ) qualified D WDFSCMDO 1 2B 0 DQDFKSASA DS Based (p_QDFKSASA ) qualified D WDFFKSAS 1 2B 0 DQDFKSAPM DS Based (p_QDFKSAPM ) qualified D WDFKSAIA 1 1 D WDFKSAII 2 3B 0 D WDFKSAOA 4 4 DQDFKFFWR DS Based (p_QDFKFFWR ) qualified D WDFFKFWS 1 2B 0 DQDFKCHKP DS Based (p_QDFKCHKP ) qualified D WDFKFWID 1 1 D WDFKFWIN 2 3B 0 D WDFKFWOV 4 5 DQDFKMFDK DS Based (p_QDFKMFDK ) qualified D WDFFKMFS 1 2B 0 D WDFKMFNO 3 4B 0 D WDFKMFEN 5 5A * p_QDFKMFDP = %ADDR(QDFKMFDK.WDFKMFEN) DQDFKMFDP DS Based (p_QDFKMFDP ) qualified D WDFKMFID 1 1 D WDFKMFIN 2 3B 0 D WDFKMFEX 4 4A * Response Indicator Structure (QDFKMFRS) * p_QDFKMFRS = %ADDR(QDFKMFDP.WDFKMFEX) DQDFKMFRS DS Based (p_QDFKMFRS ) qualified D WDFKMFRP 1 2B 0 D WDFKMFEE 3 3A * ERRMSG and ERRMSGID Keyword Structure (QDFKMFEM) * p_QDFKMFEM = %ADDR(QDFKMFRS.WDFKMFEE) DQDFKMFEM DS Based (p_QDFKMFEM ) qualified D WDFKMFTP 1 1 D WDFKMFEL 2 3B 0 D WDFKMFTX 4 4A DQDFKMFSI DS Based (p_QDFKMFSI ) qualified D WDFKMFMI 1 7 D WDFKMFMF 8 17 D WDFKMFML 18 27 D WDFKMFDL 28 29B 0 D WDFKMFMO 30 31B 0 DQDFKMFMV DS Based (p_QDFKMFMV ) qualified D WDFKMFMM 1 1 D WDFKMFMP 2 4 D WDFKMFFL 5 6B 0 D WDFKMFFV 7 16 D WDFKMFLV 17 26 DQDFKMFM3 DS Based (p_QDFKMFM3 ) qualified D WDFFKMF1 1 3 D WDFFKMF2 4 7 DQDFKMFM4 DS Based (p_QDFKMFM4 ) qualified D WDFKMFD4 1 1 DQDFKDFLD DS Based (p_QDFKDFLD ) qualified D WDFKDFLO 1 2B 0 DQDFK_DATTIMFmat DS Based (p_QDFK_DATTIMFmat) qualified D WDFK_DATTIM 1 2B 0 DQDFK_DATTIM_Sep DS Based (p_QDFK_DATTIM_Sep ) qualified D WDFK_DATTIMSep 1 1A DQDFK_DATEP DS Based (p_QDFK_DATEP) qualified * 0 BIT(1) WDFK_DATE_SYS If on, the *SYS parameter is specified on th * 1 BIT(1) WDFK_DATE_YY If on, the *YY parameter is specified on the * 2 BIT(1) WDFK_DATE_EDTCDEY If on, the EDTCDE(Y) keyword was specifi D WDFK_DATE 1 1A * Length of this structure is * is WDFK_MAPVAL_C * WDFK_MAPVAL_L * p_QDFK_MAPVAL = %ADDR(QDFKMFDP.WDFKMFEX) * Number of MAPVAL keyword parameters. * Length of each MAPVAL keyword parameter. * MAPVAL parameter DQDFK_MAPVAL DS Based (p_QDFK_MAPVAL) qualified D WDFK_MAPVAL_C 1 2B 0 D WDFK_MAPVAL_L 3 4B 0 D WDFK_MAPVAL 1 1A DQDFKDTFT DS Based (p_QDFKDTFT ) qualified D WDFKDTFT00 1 2B 0 DQDFKDTSP DS Based (p_QDFKDTSP ) qualified D WDFKDTSP00 1 1 DQDFKDATP DS Based (p_QDFKDATP ) qualified D WDFBITS56 1 1 DQDFKMPVL DS Based (p_QDFKMPVL ) qualified D WDFPVLCT 1 2B 0 D WDFPVLLN 3 4B 0 DQDFKDFT DS Based (p_QDFKDFT ) qualified D WDFFKDFS 5I 0 Overlay( QDFKDFT : 1 ) D WDFKDFPE 1A Overlay( QDFKDFT : 3 ) DQDFKDFPM DS Based (p_QDFKDFPM ) qualified D WDFKDFID 1 1 D WDFKDFTY 2 2 D WDFKDFIN 3 4B 0 D WDFKDFLN 5 6B 0 DQDFKDFMM DS Based (p_QDFKDFMM ) qualified D WDFKDFMI 1 7 D WDFKDFMF 8 17 D WDFKDFML 18 27 DQDFFHTML00 DS Based (p_QDFFHTML00 ) qualified D WDFBITS57 1 1 D WDFFHLEN 2 3B 0 D WDFFHOFF 4 5B 0 D WDFLTEXT 6 6 DQDFKEDTR DS Based (p_QDFKEDTR ) qualified D WDFFKEDS 1 2B 0 D WDFKEDKW 3 3A D xDFKEDID 4 4 D xDFKEDSY 5 5 D xDFKEDML 6 7B 0 D xDFVED73 8 8 D xDFKEDMS 9 9A D xDFKEDMSx 10 24A DQDFKEDTP DS Based (p_QDFKEDTP ) qualified D WDFKEDID 1 1 D WDFKEDSY 2 2 D WDFKEDML 3 4B 0 D WDFVED73 5 5 D WDFKEDMS 6 6A D WDFKEDMSx 6 40A DQDFKEDTMSK DS Based (p_QDFKEDTMSK) qualified D WDFKEDMNUM 5I 0 Overlay( QDFKEDTMSK : 1) D WDFKEDMSEG 1A Overlay( QDFKEDTMSK : 3) DQDFKEDTSEG DS Based (p_QDFKEDTSEG) qualified D WDFKEDMPOS 5I 0 Overlay( QDFKEDTSEG : 1) D WDFKEDMLEN 5I 0 Overlay( QDFKEDTSEG : 3) DQDFKVAKW DS Based (p_QDFKVAKW ) qualified D WDFFKVAL 1 2B 0 DQDFKVARL DS Based (p_QDFKVARL ) qualified D WDFBITS38 1 1 D WDFBITS39 2 2 D WDFVED76 3 3 D WDFKVATP 4 4 D WDFFKLAP 5 6B 0 D WDFKLATP 7 8B 0 DQDFKCKMI DS Based (p_QDFKCKMI ) qualified D WDFKCKMD 1 7 D WDFKCKMF 8 17 D WDFKCKML 18 27 D WDFKCKDL 28 29B 0 D WDFFKCKB 30 31B 0 DQDFKFCPR DS Based (p_QDFKFCPR ) qualified D WDFFKFCS 1 2B 0 DQDFKFC DS Based (p_QDFKFC ) qualified D WDFKFCID 1 1 D WDFKFCIN 2 3B 0 D WDFKFCLN 4 5B 0 DQDFKCHC DS Based (p_QDFKCHC ) qualified D WDFCHCCT 1 2B 0 D WDFCHCFN 3 12 D WDFKCHCR 13 14B 0 D WDFKCHCC 15 16B 0 D WDFCHAR1 17 17 D WDFCHAR2 18 18 D WDFVED77 19 19 DQDFDREXP DS Based (p_QDFDREXP ) qualified D WDFXPLEN 1 2B 0 D WDFOWCOL 3 4B 0 D WDFUTTER 5 6B 0 D WDFBITS40 7 8 D WDFVED81 9 18 DQDFKCHCE DS Based (p_QDFKCHCE ) qualified D WDFVED82 1 1 D WDFKCLEN 2 3B 0 D WDFBITS41 4 4 D WDFWDFKC 5 6 D WDFINX26 7 8B 0 D WDFCTXTO 9 10B 0 D WDFCTXTL 11 12B 0 D WDFCMSGO 13 14B 0 D WDFCACCO 15 16B 0 D WDFPRCDU 17 18 D WDFCPRCD 17 18B 0 D WDFBCAID 17 17 D WDFCRTNO 19 20B 0 D WDFCRTNL 21 22B 0 D WDFCCTLO 23 24B 0 D WDFCTLIO 25 26B 0 DQDFKCTXT DS Based (p_QDFKCTXT ) qualified D WDFCMNEM 1 2B 0 DQDFKCACC DS Based (p_QDFKCACC ) qualified D WDFACCSL 1 2B 0 D WDFCACCL 3 4B 0 D WDFACCFO 5 6B 0 DQDFKCMSG DS Based (p_QDFKCMSG ) qualified D WDFBITS42 1 1 D WDFID26U 2 8 D WDFMID26 2 8 D WDFKMIDO 2 3B 0 D WDFCMFLU 9 18 D WDFKCMFL 9 18 D WDFCMFLO 9 10B 0 D WDFCMLBU 19 28 D WDFKCMLB 19 28 D WDFCMLBO 19 20B 0 DQDFBSEPS DS Based (p_QDFBSEPS ) qualified D WDFBITS43 1 1 D WDFBSCOU 2 3 D WDFMBSCO 2 3B 0 D WDFBSCLR 2 2 D WDFBSAOU 4 5 D WDFMBSAO 4 5B 0 D WDFBSATR 4 4 D WDFSCHOU 6 7 D WDFBSCHO 6 7B 0 D WDFBSCHR 6 6 DQDFKCHCX DS Based (p_QDFKCHCX ) qualified D WDFVED92 1 1 D WDFHCCLR 2 2 D WDFVED93 3 3 D WDFHCATR 4 4 D WDFVED94 5 5 DQDFEFATR DS Based (p_QDFEFATR ) qualified D WDFBITS44 1 1 D WDFFACLR 2 2 D WDFVED96 3 3 D WDFFAATR 4 4 D WDFVED97 5 5 DQDFFLDCP DS Based (p_QDFFLDCP ) qualified D WDFLDNUM 1 2B 0 D WDFVED98 3 3 DQDFNTFLD DS Based (p_QDFNTFLD ) qualified D WDFLDNUM00 1 2B 0 D WDFVED99 3 3 DQDFDTMSK00 DS Based (p_QDFDTMSK00 ) qualified D WDFDMNUM 1 2B 0 DQDFDTSEG DS Based (p_QDFDTSEG ) qualified D WDFDMPOS 1 2B 0 D WDFDMLEN 3 4B 0 DQDFKSMSG DS Based (p_QDFKSMSG ) qualified D WDFBITS45 1 1 D WDFSMIDU 2 8 D WDFKSMID 2 8 D WDFSMIDO 2 3B 0 D WDFSMFLU 9 18 D WDFKSMFL 9 18 D WDFSMFLO 9 10B 0 D WDFSMLBU 19 28 D WDFKSMLB 19 28 D WDFSMLBO 19 20B 0 DQDFKGRPR DS Based (p_QDFKGRPR ) qualified D WDFKPCNT 1 2B 0 DQDFKGRWP DS Based (p_QDFKGRWP ) qualified D WDFKGPID 1 1 D WDFKGPIN 2 3B 0 D WDFKGPLN 4 5B 0 DQDFRDATR DS Based (p_QDFRDATR ) qualified D WDFCLROU 1 2 D WDFGCLRO 1 2B 0 D WDFGCLOR 1 1 D WDFLNTOU 3 4 D WDFGLNTO 3 4B 0 D WDFFKGLT 3 3 D WDFBITS46 5 5 DQDFRDCLR DS Based (p_QDFRDCLR ) qualified D WDFBITS47 1 1 D WDFSROWU 2 3 D WDFCSROW 2 3B 0 D WDFGCSRO 2 3B 0 D WDFSCOLU 4 5 D WDFCSCOL 4 5B 0 D WDFGCSCO 4 5B 0 D WDFCDEPU 6 7 D WDFGCDEP 6 7B 0 D WDFGCDEO 6 7B 0 D WDFCWIDU 8 9 D WDFGCWID 8 9B 0 D WDFGCWIO 8 9B 0 DQDFRDBOX DS Based (p_QDFRDBOX ) qualified D WDFBITS48 1 1 D WDFGBTOB 2 2 D WDFBHZOU 3 4 D WDFGBHZO 3 4B 0 D WDFKGHZV 3 4B 0 D WDFBVTOU 5 6 D WDFGBVTO 5 6B 0 D WDFKGVTV 5 6B 0 D WDFBCLOU 7 8 D WDFGBCLO 7 8B 0 D WDFGBCLR 7 7 D WDFBLTOU 9 10 D WDFGBLTO 9 10B 0 D WDFGBLNT 9 9 D WDFBCTLO 11 12B 0 DQDFOXDFM DS Based (p_QDFOXDFM ) qualified D WDFBITS49 1 1 D WDFSROWU00 2 3 D WDFBSROW 2 3B 0 D WDFGBSRO 2 3B 0 D WDFSCOLU00 4 5 D WDFBSCOL 4 5B 0 D WDFGBSCO 4 5B 0 D WDFBDEPU 6 7 D WDFGBDEP 6 7B 0 D WDFGBDEO 6 7B 0 D WDFBWIDU 8 9 D WDFGBWID 8 9B 0 D WDFGBWIO 8 9B 0 DQDFRDLIN DS Based (p_QDFRDLIN ) qualified D WDFBITS50 1 1 D WDFLTYPL 2 2 D WDFLINOU 3 4 D WDFGLINO 3 4B 0 D WDFGLINT 3 4B 0 D WDFLRPOU 5 6 D WDFGLRPO 5 6B 0 D WDFGLRPT 5 6B 0 D WDFLCLOU 7 8 D WDFGLCLO 7 8B 0 D WDFGLCLR 7 7 D WDFLLTOU 9 10 D WDFGLLTO 9 10B 0 D WDFGLLNT 9 9 D WDFLCTLO 11 12B 0 DQDFINDFM DS Based (p_QDFINDFM ) qualified D WDFBITS51 1 1 D WDFSROWU01 2 3 D WDFLSROW 2 3B 0 D WDFGLSRO 2 3B 0 D WDFSCOLU01 4 5 D WDFLSCOL 4 5B 0 D WDFGLSCO 4 5B 0 D WDFLLENU 6 7 D WDFGLLEN 6 7B 0 D WDFGLLNO 6 7B 0 DQDFWITBE DS Based (p_QDFWITBE ) qualified D WDFWINBR 1 1 D WDFWIOBF 2 2 D WDFWIIBF 3 3 D WDFWITXT 4 5B 0 DQDFWKWDA DS Based (p_QDFWKWDA ) qualified D WDFWKWDC 1 2B 0 DQDFKWIDU DS Based (p_QDFKWIDU ) qualified D WDFED117 1 1 D WDFWKWID 2 2 DQDFWATTR DS Based (p_QDFWATTR ) qualified D WDFKTYPU 1 2 D WDFWKTYP 1 2B 0 D WDFED11700 1 1 D WDFWKWID00 2 2 D WDFWKLEN 3 4B 0 DQDFWATYP DS Based (p_QDFWATYP ) qualified D WDFWALEN 1 2B 0 D WDFED118 3 3 D WDFWPRMT 4 4 DQDFWBTYP DS Based (p_QDFWBTYP ) qualified D WDFFWATS 1 2B 0 DQDFWRSTR DS Based (p_QDFWRSTR ) qualified D WDFBITS53 1 1 D WDFBITS54 2 2 D WDFWRFEI 3 6B 0 D WDFWRLBI 7 10B 0 D WDFWRRFI 11 14B 0 D WDFWRFDI 15 18B 0 D SmlIntTyp S 5I 0 D IntTyp S 10I 0 D ChrTyp S 1 D QNamTyp S 20A D NamTyp S 10A D LglTyp S N D Buftyp S 32000A *------------------------------------------------------------------- * - Work fields- *------------------------------------------------------------------- D NoAPIError C Const( *Zero ) D QualDspF S 20 D RtvSizeInfo DS D 4 D RtvSize 10I 0 D Counter S 5I 0 D #NumFlds S 10I 0 D TotFlds S 10I 0 D RecordName S 10A D FindStr s 32A varying D x s 10I 0 D c s 10I 0 D f s 10I 0 D k s 10I 0 D D xx s 10I 0 D xc s 10I 0 D xf s 10I 0 D xk s 10I 0 D D lx s 10I 0 D lc s 10I 0 D lf s 10I 0 D lk s 10I 0 D D rx s 10I 0 D rc s 10I 0 D rf s 10I 0 D rk s 10I 0 D D fx s 10I 0 D fc s 10I 0 D ff s 10I 0 D fk s 10I 0 D D cx s 10I 0 D cc s 10I 0 D cf s 10I 0 D ck s 10I 0 D D len s 10I 0 D FldIdx s 10I 0 D SizeIdx s 10I 0 D ScrnSize s 1 D SflCtl s N D RcvVarLen S Like( IntTyp ) D Idx S Like( IntTyp ) D APIErrDS DS D ApiErrLen 10I 0 Inz( %Size( APIErrDS ) ) D BytesAvail 10I 0 Inz( *Zero ) D 7 Inz( *Blanks ) D 1 Inz( X'00' ) D 256 Inz( *Blanks ) D CONSTANT C x'01' D DFT C x'01' D Bit0 C X'80' D Bit1 C X'40' D Bit2 C X'20' D Bit3 C X'10' D Bit4 C X'08' D Bit5 C X'04' D Bit6 C X'02' D Bit7 C X'01' * How to test for bits * If %Bitand(Hexval:Bit0) = Bit0; * Dsply 'Bit 0 is *On'; * Else; * Dsply 'Bit 0 is *Off'; * Endif; D KwdData s 3564A varying based(p_KwdData) D temp s like(KwdData) *%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% D col s 5I 0 D row s 5I 0 D wBinDS DS D hx1 1 1 D hx2 2 2 D wBin 1 2B 0 C CallP RtvDspFDesc( C RtvSizeInfo : C 8 : C 'DSPF0100' : C QDspFil : C APIErrDS C ) C If BytesAvail > 0 C Return *Off C EndIf C eval p_QDFFBASE = %alloc(RtvSize) *------------------------------------------------------------------- C Reset APIErrDS * Retrieve display file description ( QDFRTVFD ) API C CallP RtvDspFDesc( C QDFFBASE : C RtvSize : C 'DSPF0100' : C QDspFil : C APIErrDS C ) C If BytesAvail > 0 C Return *Off C EndIf C C Eval p_FldDtaDS = %addr(FldDta) C C C Eval NumFlds = 1 C Eval %OCCUR(FldDtaDS) = NumFlds // file header C Eval p_QDFFINFO = p_QDFFBASE + QDFFBASE.WDFFINFO // file where used C Eval p_QDFWFLEI = p_QDFFINFO + QDFFINFO.WDFFWUOF // file Dev Dep C Eval p_QDFFDPDD = p_QDFFINFO + QDFFINFO.WDFFXDOF // rec where used (first) C Eval p_QDFWRCDI = p_QDFWFLEI + QDFWFLEI.WDFWXLEN // name table C Eval p_QDFFNTBL = p_QDFWFLEI + QDFWFLEI.WDFWNTBO // File Keywords C EXSR FileKwds // process record formats C for xx = 0 to (QDFFBASE.WDFFRCS - 1) C if xx <> 0 C Eval p_QDFWRCDI = p_QDFWRCDI + QDFWRCDI.WDFWNXTR C Endif // record format C eval p_QDFARFTE = p_QDFFINFO + QDFFINFO.WDFFDFLO + C (%size(QDFARFTE) * xx) C eval RecordName = QDFARFTE.WDFARFNM C C if %subst(RecordName:1:1) <> '*' C EXSR ProcessRecFmt C endif C endfor C C DeAlloc p_QDFFBASE C Return *On *------------------------------------------------ * Process a record format. *------------------------------------------------ CSR ProcessRecFmt begsr // record header C eval p_QDFFRINF = p_QDFFINFO + QDFARFTE.WDFARFOF // record dev dept C eval p_QDFFRDPD = p_QDFFRINF + QDFFRINF.WDFFRAOF * SFLCTL * 12 C BIN(31) WDFFRFLG Miscellaneous record contents. * 12 C 0 BIT(1) WDFFUDDS If on, USRDFN keyword is specified. * 12 C 1 BIT(1) WDFFSFL If on, SFL keyword is specified (next record * 12 C 2 BIT(1) WDFFSFLC If on, SFLCTL keyword is specified (prev C eval SflCtl = *off C if %bitand(QDFFRINF.WDFFRFLG1 : Bit2) = Bit2 C eval p_QDFFSFCR = p_QDFFRINF + QDFFRINF.WDFFRAOF C eval p_QDFFSFHR = %addr(QDFFSFCR.WDFFSFPM) C eval SflCtl = *on C endif C for SizeIdx = 0 to QDFFBASE.WDFFSCR -1 C eval p_QDFFSCRA = %addr( QDFFBASE.WDFFSCRS) + C %size(QDFFSCRA) * SizeIdx // *DS3 = X'03' *DS4 = X'04' C eval ScrnSize = QDFFSCRA.WDFFSCIA C endfor // Row Col table C eval p_QDFFRCTB = p_QDFFRINF + QDFFRDPD.WDFFDRCO C C eval TotFlds = QDFFRINF.WDFFFLD // Record Keywords C EXSR RcdKwds C C EXSR ProcessRcdFld CSR endsr CSR ProcessRcdFld begsr * - Field Where Used - C eval p_QDFWFLDI = p_QDFWRCDI + QDFWRCDI.WDFWRLEN C eval p_QDFFFITB = p_QDFFRINF + QDFFRINF.WDFFOFIT C +( QDFWFLDI.WDFWRRDX -1) * %len(QDFFFITB) C for FldIdx = 0 to QDFFRINF.WDFFFLD -1 C Exsr GetFldInfo C Exsr FieldKwds * p_QDFWFLDI = p_QDFWFLDI + WDFWFLDL next C if FldIdx < QDFFRINF.WDFFFLD -1 C eval p_QDFWFLDI = p_QDFWFLDI + C QDFWFLDI.WDFWFLDL * Field Indexing Table (QDFFFITB) for next Field C eval p_QDFFFITB = p_QDFFRINF + QDFFRINF.WDFFOFIT C +( QDFWFLDI.WDFWRRDX -1) * %len(QDFFFITB) C endif C Eval #NumFlds = NumFlds C Eval NumFlds += 1 C Eval %OCCUR(FldDtaDS) = NumFlds C Clear #FmtNam C Clear #FldNam C Clear #FldDTUS C Clear #FldEdt C Clear #FldLen C Clear #FldPlen C Clear #FldDec C Clear #FldAtr C Clear #FldRow C Clear #FldCol C Clear #FldCom C C endfor C C C CSR endsr CSR GetFldInfo begsr * C eval #FmtNam = RecordName * - Field Header C eval p_QDFFFINF = p_QDFFRINF + QDFFFITB.WDFFFOFS C if QDFFFINF.WDFFFIOA = x'01' C eval p_QDFFFCON = %ADDR(QDFFFINF.WDFFFTBE) C eval p_QDFFFDPD = p_QDFFFINF + QDFFFCON.WDFFFAOC C else * Variable C eval p_QDFFFNAM = %ADDR(QDFFFINF.WDFFFTBE) C eval p_QDFFFDPD = p_QDFFFINF + QDFFFNAM.WDFFFAOF C eval p_QDFFFDIC = %addr(QDFFFDPD.WDFFFICE) C endif * Field Extension C eval p_QDFFXFDP = p_QDFFFINF + QDFFFDPD.WDFFXFDO * Row Column C eval p_QDFFRCTB = p_QDFFRINF + QDFFRDPD.WDFFDRCO C + (QDFWFLDI.WDFWRRDX -1) *2 C eval p_QDFFRCTE = %addr(QDFFRCTB.WDFFRC) * C eval hx1 = x'00' C eval hx2 = QDFFRCTE.WDFFSROW C eval row = wBin C eval hx1 = x'00' C eval hx2 = QDFFRCTE.WDFFSCOL C eval col = wBin C eval #FldRow = row C eval #FldCol = col * date time flags C if %bitand(QDFFFINF.WDFFBFLG : Bit0) = Bit0 C eval #FldCom = 'DATE' C eval #FldDTUS = 'D' C endif C if %bitand(QDFFFINF.WDFFBFLG : Bit1) = Bit1 C eval #FldDTUS = 'Y' C endif C if %bitand(QDFFFINF.WDFFBFLG : Bit2) = Bit2 C eval #FldDTUS = 'T' C endif C if %bitand(QDFFFINF.WDFFFBIT : Bit4) = Bit4 C eval #FldDTUS = 'U' C endif C if %bitand(QDFFFINF.WDFFFBIT : Bit5) = Bit5 C eval #FldDTUS = 'S' C endif * * CONSTANTS C if QDFFFINF.WDFFFIOA = x'01' C EXSR ProcessCons C ELSE * Field Name C eval p_QDFFNTB = %addr(QDFFNTBL.WDFFNMES) + C + 10 * (QDFWFLDI.WDFWNMEI -1) * * QDFFFINF.WDFFFIOA *Field attribute. *X'01' indicates Constant (see structure QDFFFCON, Constant Field Header *X'02' indicates Output (O), *X'03' indicates Message (M), h (B), *X'04' indicates Input (I), (P) *X'05' indicates Both (B), *X'06' indicates Hidden (H), and *X'07' indicates Program to System (P) C eval #FldIO = QDFFFINF.WDFFFIOA * WDFFKBDT * Keyboard shift and data type. * X'00' indicates Alpha shift/character (A), * X'01' indicates Alpha only (X), * X'02' indicates Numeric shift (N), * X'03' indicates Numeric only (Y), * X'04' indicates Katakana (K), * X'05' indicates Digits only (D), * X'06' indicates Inhibit keyboard (I), * X'07' indicates Signed numeric/zoned (S), * X'08' indicates Binary (B), X'09' indicates Packed (P), * X'0A' indicates Floating (F), * X'0B' indicates DBCS (J), * X'0C' indicates Open (O), X'0D' indicates Either (E), * X'0E' indicates Numeric-only character (M), * X'0F' indicates Graphic (G), * X'10' indicates Date (L), * X'11' indicates Time (T), and * X'12' indicates Timestamp (Z) C eval #FldAtr = QDFFFNAM.WDFFKBDT C eval #FldNam = QDFFNTB.WDFFNAM C eval #FldCom = *blank C eval #FldPlen = QDFFFNAM.WDFFPLEN C eval #FldDec = QDFFFNAM.WDFFDEC C endif CSR endsr *------------------------------------------------ * This loops through all keyword categories * for a constant field (text on the screen.) *------------------------------------------------ CSR ProcessCons begsr C C* C if (QDFFFDPD.WDFFFDOC > 0) C* C eval p_QDFFCOSA = p_QDFFFINF + C QDFFFDPD.WDFFFDOC C* C for cc = 0 to (QDFFCOSA.WDFFCCT - 1) C* C eval p_QDFFCCOA = %addr(QDFFCOSA.WDFFCCOS) C + (cc * %size(QDFFCCOA)) C if (QDFFCCOA.WDFFCAID = x'22') C eval p_QDFKMFDK= p_QDFFFINF + C QDFFCCOA.WDFFCAOF C exsr ProcessCat22 C endif C if (QDFFCCOA.WDFFCAID = x'23') C eval p_QDFKDFT = p_QDFFFINF + C QDFFCCOA.WDFFCAOF C exsr ProcessCat23 C endif C C if (QDFFCCOA.WDFFCAID = x'24') C eval p_QDFKEDTR = p_QDFFFINF + C QDFFCCOA.WDFFCAOF C exsr ProcessCat24 C endif C endfor C C endif C CSR endsr *------------------------------------------------ * Process File Keywords. *------------------------------------------------ CSR FileKwds begsr C C if (QDFFDPDD.WDFFXDOC > 0) C* C eval p_QDFFCOSA = p_QDFFINFO + C QDFFDPDD.WDFFXDOC C* C for lc = 0 to (QDFFCOSA.WDFFCCT - 1) C* C eval p_QDFFCCOA = %addr(QDFFCOSA.WDFFCCOS) C + (lc * %size(QDFFCCOA)) C eval p_QDFKFILK = p_QDFFINFO + C QDFFCCOA.WDFFCAOF C for lk = 1 to QDFKFILK.WDFFKFIL C if (lk=1) C eval p_QDFKFLPM = %addr(QDFKFILK.WDFKFILE) C else C eval p_QDFKFLPM = p_QDFKFLPM + C %size(QDFKFLPM ) C endif C C eval p_QDFKFLPP = %addr(QDFKFLPM.WDFKFLEX) C for lx = 1 to QDFKFLPM.WDFFKFLP C C select C when QDFKFLPM.WDFKFLID = x'02' C eval p_QDFKFLSZ = %addr(QDFKFLPP.WDFKFLNM) C when QDFKFLPM.WDFKFLID = x'04' C eval p_QDFKICVP = %addr(QDFKFLPP.WDFKFLNM) C when QDFKFLPM.WDFKFLID = x'05' C eval p_QDFKHARD = %addr(QDFKFLPP.WDFKFLNM) C when QDFKFLPM.WDFKFLID = x'06' C eval p_QDFKHXPS = %addr(QDFKFLPP.WDFKFLNM) C when QDFKFLPM.WDFKFLID = x'07' C eval p_QDFKHDOC = %addr(QDFKFLPP.WDFKFLNM) C when QDFKFLPM.WDFKFLID = x'08' C eval p_QDFKSIDX = %addr(QDFKFLPP.WDFKFLNM) C when QDFKFLPM.WDFKFLID = x'0A' C eval p_QDFKFALX = %addr(QDFKFLPP.WDFKFLNM) C when QDFKFLPM.WDFKFLID = x'0B' C eval p_QDFKESFL = %addr(QDFKFLPP.WDFKFLNM) C when QDFKFLPM.WDFKFLID = x'0C' C eval p_QDFKBODR = %addr(QDFKFLPP.WDFKFLNM) C endsl C eval p_QDFKFLPP = C p_QDFKFLPP + (QDFKFLPP.WDFKFLLN) C endfor C endfor C C C endfor C C endif C CSR endsr *------------------------------------------------ * Process Record Keywords. *------------------------------------------------ CSR RcdKwds begsr C if (QDFFRDPD.WDFFRDOC > 0) C* C eval p_QDFFCOSA = p_QDFFRINF + C QDFFRDPD.WDFFRDOC C for rc = 0 to (QDFFCOSA.WDFFCCT - 1) C* C eval p_QDFFCCOA = %addr(QDFFCOSA.WDFFCCOS) C + (rc * %size(QDFFCCOA)) * Miscellaneous record-level keywords (uses (QDFKMSAP)) * no structures for IDs X'01', X'02', X'03', X'04', X'05', X'06', X'07', * ID Keyword ID Keyword * X'01' LOCK X'09' RMVWDW * X'02' ALARM X'0F' DSPMOD * X'03' BLINK X'10' CSRLOC * X'04' LOGOUT X'11' INDARA * X'05' ALWGPH X'13' SETOFF * X'06' MSGALARM X'15' RTNCSRLOC * X'07' RETLCKSTS X'16' MNUBARDSP * X'08' USRRSTDSP C eval p_QDFKMSRL = p_QDFFRINF + C QDFFCCOA.WDFFCAOF * Command Key Keyword Structure (QDFKCKKW) (uses (QDFKCKKE)) * Use structure QDFKCKKE for category 2 keyword IDs X'01' through X'25' an * Use structure QDFKCKKE for category 2 keyword IDs X'01' through X'25' an * ID Keyword ID Keyword ID Keyword * X'01' CA/CF01 X'0E' CA/CF14 X'1A' ROLLDOWN * X'02' CA/CF02 X'0F' CA/CF15 X'1B' PRINT * X'03' CA/CF03 X'10' CA/CF16 X'1C' HOME * X'04' CA/CF04 X'11' CA/CF17 X'1D' CLEAR * X'05' CA/CF05 X'12' CA/CF18 X'1E' HELP * X'06' CA/CF06 X'13' CA/CF19 X'20' HLPRTN * X'07' CA/CF07 X'14' CA/CF20 X'21' VLDCMDKEY * X'08' CA/CF08 X'15' CA/CF21 X'22' ALTHELP * X'09' CA/CF09 X'16' CA/CF22 X'23' ALTPAGEUP * X'0A' CA/CF10 X'17' CA/CF23 X'24' ALTPAGEDWN * X'0B' CA/CF11 X'18' CA/CF24 X'25' MNUBARSW * X'0C' CA/CF12 X'19' ROLLUP X'30' MNUCNL * X'0D' CA/CF13 C eval p_QDFKCKKW = p_QDFFRINF + C QDFFCCOA.WDFFCAOF C for rk = 1 to QDFKCKKW.WDFFKCKS C if (rk=1) C eval p_QDFKCKKE = %addr(QDFKCKKW.WDFKCKCM) C else C eval p_QDFKCKKE = p_QDFKCKKE + C %size(QDFKCKKE ) C endif C C eval p_QDFKFLPP = %addr(QDFKFLPM.WDFKFLEX) C for rx = 1 to QDFKFLPM.WDFFKFLP C C* this is unfinished C eval p_QDFKFLPP = C p_QDFKFLPP + (QDFKFLPP.WDFKFLLN) C endfor C endfor C C C endfor C C endif C CSR endsr *------------------------------------------------ * Process Record Keywords. *------------------------------------------------ CSR FieldKwds begsr C* C if (QDFFFDPD.WDFFFDOC > 0) C* C eval p_QDFFCOSA = p_QDFFFINF + C QDFFFDPD.WDFFFDOC C* C for fc = 0 to (QDFFCOSA.WDFFCCT - 1) C* C eval p_QDFFCCOA = %addr(QDFFCOSA.WDFFCCOS) C + (fc * %size(QDFFCCOA)) C if (QDFFCCOA.WDFFCAID = x'23') C eval p_QDFKDFT = p_QDFFFINF + C QDFFCCOA.WDFFCAOF C exsr ProcessCat23 C endif C C endfor C C endif C CSR endsr *------------------------------------------------ * This loops through all keywords that fall into * category 22 *------------------------------------------------ CSR ProcessCat22 begsr C for ck = 1 to QDFKMFDK.WDFFKMFS C if (ck=1) C eval p_QDFKMFDP = %ADDR(QDFKMFDK.WDFKMFEN) C else C eval p_QDFKMFDP = p_QDFKMFDP + C %size(QDFKMFDP ) C endif C select C when QDFKMFDP.WDFKMFID = x'10' C eval p_QDFKMFMV = %ADDR(QDFKMFDP.WDFKMFEX) C when QDFKMFDP.WDFKMFID = x'15' C eval p_QDFKMFRS = %ADDR(QDFKMFDP.WDFKMFEX) C eval p_QDFKMFEM = %ADDR(QDFKMFRS.WDFKMFEE) C when QDFKMFDP.WDFKMFID = x'16' C eval p_QDFKMFRS = %ADDR(QDFKMFDP.WDFKMFEX) C eval p_QDFKMFEM = %ADDR(QDFKMFRS.WDFKMFEE) C eval p_QDFKMFSI = %ADDR(QDFKMFEM.WDFKMFTX) C when QDFKMFDP.WDFKMFID = x'17' C eval p_QDFKDFLD = %ADDR(QDFKMFDP.WDFKMFEX) C when QDFKMFDP.WDFKMFID = x'18' C eval p_QDFK_DATTIMFmat = %ADDR(QDFKMFDP.WDFKMFEX) * WDFK_DATTIM * Format used for a field with the date or time data type. * X'01' indicates *JOB, * X'02' indicates *MDY, * X'03' indicates *DMY, * X'04' indicates *YMD, * X'05' indicates *JUL, * X'06' indicates *ISO, * X'07' indicates *USA, * X'08' indicates *EUR, * X'09' indicates *JIS, * X'0A' indicates *H C when QDFKMFDP.WDFKMFID = x'19' C eval p_QDFK_DATTIM_Sep = %ADDR(QDFKMFDP.WDFKMFEX) C eval QDFK_DATTIM_Sep.WDFK_DATTIMSep = C QDFK_DATTIM_Sep.WDFK_DATTIMSep C C when QDFKMFDP.WDFKMFID = x'1A' C eval p_QDFK_DATEP = %ADDR(QDFKMFDP.WDFKMFEX) C eval QDFK_DATEP.WDFK_DATE = QDFK_DATEP.WDFK_DATE * 0 BIT(1) WDFK_DATE_SYS If on, the *SYS parameter is specified * 1 BIT(1) WDFK_DATE_YY If on, the *YY parameter is specified * 2 BIT(1) WDFK_DATE_EDTCDEY If on, the EDTCDE(Y) keyword was specify C* If %Bitand(WDFK_DATE:Bit0) = Bit0 C* If %Bitand(WDFK_DATE:Bit1) = Bit1 C* If %Bitand(WDFK_DATE:Bit2) = Bit2 C when QDFKMFDP.WDFKMFID = x'1B' C eval p_QDFK_MAPVAL = %ADDR(QDFKMFDP.WDFKMFEX) C endsl C endfor C C C CSR endsr *------------------------------------------------ * This loops through all keywords that fall into * category 23 (DFT, MSGCON, DFTVAL, HTML) *------------------------------------------------ CSR ProcessCat23 begsr C for ck = 1 to QDFKDFT.WDFFKDFS C if (ck=1) C eval p_QDFKDFPM = %addr(QDFKDFT.WDFKDFPE) C else C eval p_QDFKDFPM = p_QDFKDFPM + C %size(QDFKDFPM ) C endif C if (QDFKDFPM.WDFKDFID = DFT) C eval p_KwdData = p_QDFKDFPM + C %size(QDFKDFPM ) - 2 C eval Temp = KwdData C C eval #FldLen = QDFKDFPM.WDFKDFLN C eval #FldIO = QDFFFINF.WDFFFIOA C eval #FldCom = Temp C C endif C C endfor CSR endsr *------------------------------------------------ * This loops through all keywords that fall into * category 24 (Date, Time) *------------------------------------------------ CSR ProcessCat24 begsr C for ck = 1 to QDFKEDTR.WDFFKEDS C if (ck=1) C eval p_QDFKEDTP = %addr(QDFKEDTR.WDFKEDKW ) C else C eval p_QDFKEDTP = p_QDFKEDTP + C %size(QDFKEDTP ) C endif C C * EDIT Keyword Structure (QDFKEDTP) * Use this structure for category 24 keywords that * have keyword IDs of X'01' and X'02'. * Type Variable Name Field * CHAR(1) WDFKEDID Keyword ID. * CHAR(1) WDFKEDSY Zero suppress or fill character for the EDTCDE k * BIN(15) WDFKEDML Length of the edit mask. * CHAR(1) * Reserved. * CHAR(*) WDFKEDMS The edit mask for the EDTCDE and EDTWRD keywords * C eval #FldEdt = %subst(QDFKEDTP.WDFKEDMSX : 1 C : QDFKEDTP.WDFKEDML) C eval #FldLen = QDFKEDTP.WDFKEDML C eval #FldIO = QDFFFINF.WDFFFIOA C endfor CSR endsr P RtvFlds E
DSMFD Driver
To use this program do:-
CALL DSMFD ('urlib' 'urdspf')
It will present a list of Display Records to you that you can select to see how the display file looks on the screen.
h Option(*NODEBUGIO) // CRTRPGMOD MODULE(urlib/DSMFD) // SRCFILE(urlib/ursrcfile) // SRCMBR(DSMFD) REPLACE(*YES) // CRTSRVPGM SRVPGM(urlib/DSPFINFO) // MODULE(urlib /DSPFINFO) // EXPORT(*ALL) // CRTPGM PGM(urlib/DSMFD) MODULE(urlib/DSMFD) // BNDSRVPGM((urlib/DSPFINFO *IMMED) ) // CALL urlib/DSMFD ('*LIBL ' 'CDISPRF ') D DSMFD PR D 10 D 10 D DSMFD PI D $Lib 10 D $Fil 10 D $FilQul S 20 /if defined(QSNAPI_H) /eof /endif /define QSNAPI_H *------------------------------------------------------------- * Simple data types *------------------------------------------------------------- D Q_Handle_T s 10I 0 based(Template) D Qsn_Cmd_Buf_T s like(Q_Handle_T) based(Template) D Qsn_Inp_Buf_T s like(Q_Handle_T) based(Template) D Qsn_Env_T s like(Q_Handle_T) based(Template) D QSN_FAIL c -1 *------------------------------------------------------------- * QsnCrtCmdBuf(): Create command buffer *------------------------------------------------------------- D QsnCrtCmdBuf PR 10I 0 extproc('QsnCrtCmdBuf') D InitSize 10I 0 const D IncrAmt 10I 0 const options(*omit) D MaxSize 10I 0 const options(*omit) D Handle 10I 0 options(*omit) D ErrorCode 32767A options(*omit: *varsize) *------------------------------------------------------------- * QsnCrtInpBuf(): Create Input Buffer *------------------------------------------------------------- D QsnCrtInpBuf PR 10I 0 extproc('QsnCrtInpBuf') D BufSize 10I 0 const D IncrAmt 10I 0 const options(*omit) D MaxSize 10I 0 const options(*omit) D Handle 10I 0 options(*omit) D ErrorCode 32767A options(*omit: *varsize) *------------------------------------------------------------- * QsnClrBuf(): Clear/Reset Buffer (any type) *------------------------------------------------------------- D QsnClrBuf PR 10I 0 extproc('QsnClrBuf') D BufHandle 10I 0 const D ErrorCode 32767A options(*omit: *varsize) *------------------------------------------------------------- * QsnDltBuf(): Delete buffer (any type) *------------------------------------------------------------- D QsnDltBuf PR 10I 0 extproc('QsnDltBuf') D BufHandle 10I 0 const D ErrorCode 32767A options(*omit: *varsize) *------------------------------------------------------------- * QsnClrScr(): Clear screen *------------------------------------------------------------- D QsnClrScr PR 10I 0 extproc('QsnClrScr') D mode 1A const options(*omit) D cmdbuf 10I 0 const options(*omit) D LowEnvHandle 10I 0 const options(*omit) D ErrorCode 32767A options(*omit: *varsize) *------------------------------------------------------------- * QsnWrtDta(): Write data to the display *------------------------------------------------------------- D QsnWrtDta PR 10I 0 extproc('QsnWrtDta') D Data 32767A const options(*varsize) D DataLen 10I 0 const D FieldID 10I 0 const options(*omit) D Row 10I 0 const options(*omit) D Column 10I 0 const options(*omit) D StrMonoAttr 1A const options(*omit) D EndMonoAttr 1A const options(*omit) D StrColorAttr 1A const options(*omit) D EndColorAttr 1A const options(*omit) D CmdBufHandle 10I 0 const options(*omit) D LowEnvHandle 10I 0 const options(*omit) D ErrorCode 32767A options(*omit: *varsize) *------------------------------------------------------------- * QsnSetFld(): Add a field to the display *------------------------------------------------------------- D QsnSetFld PR 10I 0 extproc('QsnSetFld') D FieldID 10I 0 const options(*omit) D FieldLen 10I 0 const options(*omit) D Row 10I 0 const options(*omit) D Column 10I 0 const options(*omit) D FFW 2A const options(*omit) D FCW 2A const dim(32767) D options(*omit: *varsize) D NumOfFCW 10I 0 const options(*omit) D MonoAttr 1A const options(*omit) D ColorAttr 1A const options(*omit) D CmdBufHandle 10I 0 const options(*omit) D LowEnvHandle 10I 0 const options(*omit) D ErrorCode 32767A options(*omit: *varsize) *------------------------------------------------------------- * QsnReadInp(): Read data and wait for AID key *------------------------------------------------------------- D QsnReadInp PR 10I 0 extproc('QsnReadInp') D CC1 1A const D CC2 1A const D DataBytes 10I 0 options(*omit) D InpBufHandle 10I 0 options(*omit) D CmdBufHandle 10I 0 options(*omit) D LowEnvHandle 10I 0 options(*omit) D ErrorCode 32767A options(*omit: *varsize) *------------------------------------------------------------- * QsnPutBuf(): Send command output buffer to terminal *------------------------------------------------------------- D QsnPutBuf PR 10I 0 extproc('QsnPutBuf') D CmdBufHandle 10I 0 const D LowEnvHandle 10I 0 const options(*omit) D ErrorCode 32767A options(*omit: *varsize) *------------------------------------------------------------- * QsnPutGetBuf(): Send command output buffer to terminal * then wait for input buffer from terminal *------------------------------------------------------------- D QsnPutGetBuf PR 10I 0 extproc('QsnPutGetBuf') D CmdBufHandle 10I 0 const D InpBufHandle 10I 0 const D LowEnvHandle 10I 0 const options(*omit) D ErrorCode 32767A options(*omit: *varsize) *------------------------------------------------------------- * QsnRtvDta(): Get pointer to input data in input buffer *------------------------------------------------------------- D QsnRtvDta PR * extproc('QsnRtvDta') D InpBufHandle 10I 0 const D PtrToData * const options(*omit) D ErrorCode 32767A options(*omit: *varsize) *------------------------------------------------------------- * QsnRtvDtaLen(): Get length of input data in input buffer *------------------------------------------------------------- D QsnRtvDtaLen PR 10I 0 extproc('QsnRtvDtaLen') D InpBufHandle 10I 0 const D DataLen 10I 0 const options(*omit) D ErrorCode 32767A options(*omit: *varsize) *------------------------------------------------------------- * *------------------------------------------------------------- D Qsn_Env_Desc_T... D DS qualified based(Template) D color_support 1A D CDRA 1A D CDRA_3F 1A D DBCS_support 1A D coexist 1A D alt_help 1A D tgt_dev 10A D disp_file 20A D invite_active 1A D prevent_ovrd 1A *------------------------------------------------------------- * *------------------------------------------------------------- D Qsn_Env_Rtv_Desc_T... D DS qualified based(Template) D bytes_rtn 10I 0 D bytes_avail 10I 0 D color_support 1A D CDRA 1A D CDRA_3F 1A D DBCS_support 1A D coexist 1A D alt_help 1A D tgt_dev 10A D dsp_file 20A D invite_active 1A D prevent_ovrd 1A *------------------------------------------------------------- * Constants used for creating/querying the environment *------------------------------------------------------------- D QSN_COLOR_NO... D C '1' D QSN_COLOR_YES... D C '2' D QSN_COLOR_SELECT... D C '3' D QSN_CDRA_STD... D C '1' D QSN_CDRA_CNVT... D C '2' D QSN_DBCS_STD... D C '1' D QSN_DBCS_ONLY... D C '2' D QSN_DBCS_EITHER... D C '3' D QSN_DBCS_MIXED... D C '4' D QSN_COEXIST_YES... D C '1' D QSN_COEXIST_NO... D C '2' D QSN_ALTHELP_NO... D C '1' D QSN_TGT_REQ... D C '*REQUESTER' D QSN_INVITE_NO... D C '1' D QSN_INVITE_YES... D C '2' D QSN_PREVENT_OVERRIDE_NO... D C '1' D QSN_PREVENT_OVERRIDE_YES... D C '2' D QSN_SAME C '0' D QSN_DSP03 C '3' D QSN_DSP04 C '4' *------------------------------------------------------------- * AID keys (function keys, et al) *------------------------------------------------------------- D Qsn_F1 C X'31' D Qsn_F2 C X'32' D Qsn_F3 C X'33' D Qsn_F4 C X'34' D Qsn_F5 C X'35' D Qsn_F6 C X'36' D Qsn_F7 C X'37' D Qsn_F8 C X'38' D Qsn_F9 C X'39' D Qsn_F10 C X'3A' D Qsn_F11 C X'3B' D Qsn_F12 C X'3C' D Qsn_F13 C X'B1' D Qsn_F14 C X'B2' D Qsn_F15 C X'B3' D Qsn_F16 C X'B4' D Qsn_F17 C X'B5' D Qsn_F18 C X'B6' D Qsn_F19 C X'B7' D Qsn_F20 C X'B8' D Qsn_F21 C X'B9' D Qsn_F22 C X'BA' D Qsn_F23 C X'BB' D Qsn_F24 C X'BC' D Qsn_SLP C X'3F' D Qsn_FET C X'50' D Qsn_PA1 C X'6C' D Qsn_PA2 C X'6E' D Qsn_PA3 C X'6B' D Qsn_Clear C X'BD' D Qsn_Enter C X'F1' D Qsn_Help C X'F3' D Qsn_RollDown C X'F4' D Qsn_RollUp C X'F5' D Qsn_PageUp C X'F4' D Qsn_PageDown C X'F5' D Qsn_Print C X'F6' D Qsn_RecBS C X'F8' DQsn5250QY C '1' DQsn5250QN C '2' DQsn5250QF C '3' *------------------------------------------------------------- * Control Characters ( CC1 & CC2 ) *------------------------------------------------------------- D QSN_CC1_NULL... D C X'00' D QSN_CC1_LOCKBD... D C X'20' D QSN_CC1_MDTNBY... D C X'40' D QSN_CC1_MDTALL... D C X'60' D QSN_CC1_CLRMOD... D C X'80' D QSN_CC1_MDTNBY_CLRALL... D C X'A0' D QSN_CC1_MDTNBY_CLRMOD... D C X'C0' D QSN_CC1_MDTALL_CLRALL... D C X'E0' D QSN_CC2_NULL... D C X'00' D QSN_CC2_NO_IC... D C X'40' D QSN_CC2_RST_CSR_BL... D C X'20' D QSN_CC2_SET_CSR_BL... D C X'10' D QSN_CC2_UNLOCKBD... D C X'08' D QSN_CC2_ALARM... D C X'04' D QSN_CC2_MSG_OFF... D C X'02' D QSN_CC2_MSG_ON... D C X'01' *------------------------------------------------------------- * Screen Attributes *------------------------------------------------------------- D QSN_NO_SA... D C X'00' D QSN_SA_NORM... D C X'20' D QSN_SA_CS... D C X'30' D QSN_SA_BL... D C X'28' D QSN_SA_UL... D C X'24' D QSN_SA_HI... D C X'22' D QSN_SA_RI... D C X'21' D QSN_SA_ND... D C X'27' D QSN_SA_GRN... D C X'20' D QSN_SA_GRN_RI... D C X'21' D QSN_SA_WHT... D C X'22' D QSN_SA_WHT_RI... D C X'23' D QSN_SA_GRN_UL... D C X'24' D QSN_SA_GRN_UL_RI... D C X'25' D QSN_SA_WHT_UL... D C X'26' D QSN_SA_RED... D C X'28' D QSN_SA_RED_RI... D C X'29' D QSN_SA_RED_BL... D C X'2A' D QSN_SA_RED_RI_BL... D C X'2B' D QSN_SA_RED_UL... D C X'2C' D QSN_SA_RED_UL_RI... D C X'2D' D QSN_SA_RED_UL_BL... D C X'2E' D QSN_SA_ND_2F... D C X'2F' D QSN_SA_TRQ_CS... D C X'30' D QSN_SA_TRQ_CS_RI... D C X'31' D QSN_SA_YLW_CS... D C X'32' D QSN_SA_YLW_CS_RI... D C X'33' D QSN_SA_TRQ_UL... D C X'34' D QSN_SA_TRQ_UL_RI... D C X'35' D QSN_SA_YLW_UL... D C X'36' D QSN_SA_ND_37... D C X'37' D QSN_SA_PNK... D C X'38' D QSN_SA_PNK_RI... D C X'39' D QSN_SA_BLU... D C X'3A' D QSN_SA_BLU_RI... D C X'3B' D QSN_SA_PNK_UL... D C X'3C' D QSN_SA_PNK_UL_RI... D C X'3D' D QSN_SA_BLU_UL... D C X'3E' D QSN_SA_ND_3F... D C X'3F' *------------------------------------------------------------- * Ideographic shift-in and shift-out *------------------------------------------------------------- D QSN_SO C X'0E' D QSN_SI C X'0F' *------------------------------------------------------------- * Field Format Words *------------------------------------------------------------- D QSN_NO_FFW C X'0000' D QSN_FFW_BYPASS C X'6000' D QSN_FFW_DUP C X'5000' D QSN_FFW_MDT C X'4800' D QSN_FFW_ALPHA_SHIFT... D C X'4000' D QSN_FFW_ALPHA_ONLY... D C X'4100' D QSN_FFW_NUM_SHIFT... D C X'4200' D QSN_FFW_NUM_ONLY... D C X'4300' D QSN_FFW_KATA... D C X'4400' D QSN_FFW_DIGIT_ONLY... D C X'4500' D QSN_FFW_IO... D C X'4600' D QSN_FFW_SIGNED_NUMERIC... D C X'4700' D QSN_FFW_AUTO_ENTER... D C X'4080' D QSN_FFW_FER... D C X'4040' D QSN_FFW_AUTO_FER... D C X'4040' D QSN_FFW_MONOCASE... D C X'4020' D QSN_FFW_AUTO_MONOCASE... D C X'4020' D QSN_FFW_ME... D C X'4008' D QSN_FFW_NOADJUST... D C X'4000' D QSN_FFW_RA_ZERO... D C X'4005' D QSN_FFW_RA_BLANK... D C X'4006' D QSN_FFW_MF... D C X'4007' D QSN_FCW_RESEQ... D C X'8000' D QSN_FCW_MSR... D C X'8101' D QSN_FCW_SLP... D C X'8102' D QSN_FCW_MSR_SLP... D C X'8103' D QSN_FCW_SLP_SA... D C X'8106' D QSN_FCW_DBCS_ONLY... D C X'8200' D QSN_FCW_DBCS_PURE... D C X'8220' D QSN_FCW_DBCS_EITHER... D C X'8240' D QSN_FCW_DBCS_OPEN... D C X'8280' D QSN_FCW_DBCS_OPEN_CO... D C X'82C0' D QSN_FCW_TRANSPARENT... D C X'8400' D QSN_FCW_FET... D C X'8501' D QSN_FCW_CONT_FIRST... D C X'8601' D QSN_FCW_CONT_LAST... D C X'8602' D QSN_FCW_CONT_MIDDLE... D C X'8603' D QSN_FCW_CP... D C X'8800' D QSN_FCW_HL... D C X'8900' D QSN_FCW_PDS... D C X'8A00' D QSN_FCW_MOD11... D C X'B140' D QSN_FCW_MOD10... D C X'B1A0' D QSN_READ_INP... D C X'42' D QSN_READ_MDT... D C X'52' D QSN_READ_IMM... D C X'72' D QSN_READ_MDT_ALT... D C X'82' /if defined(TO_BE_CONVERTED_LATER) * * Structure definitions. * DQsnEnvExtI DS * Data structure for QsnCrtEnv API. D QsnEEDta * D QsnEEChg * procptr D QsnEEDlt * procptr DQsnEnvWM DS * Data structures for QsnSetEnvWinMod API. D QsnEWAtrC 1A D QsnEWULR 10I 0 D QsnEWULC 10I 0 D QsnEWNumR 10I 0 D QsnEWNumC 10I 0 DQsnREnvWM DS * Data structures for QsnRtvEnvWinMod API. D QsnREWRet 10I 0 D QsnREWAvl 10I 0 D QsnREWMode 1A D QsnREWAtr 1A D QsnREWULR 10I 0 D QsnREWULC 10I 0 D QsnREWNumR 10I 0 D QsnREWNumC 10I 0 DQsnQ5250 DS * Data structure for QsnQry5250 API. D QsnQ5Ret 10I 0 D QsnQ5Avl 10I 0 D QsnQ5Stat 1A D QsnQ5Wkstn 4B 0 D QsnQ5CLvl 3A D QsnQ5R1 16A D QsnQ5WType 1A D QsnQ5MType 4A D QsnQ5Model 3A D QsnQ5KbdID 1A D QsnQ5EKbd 1A D QsnQ5PcKbd 1A D QsnQ5SNum 4A D QsnQ5MaxIn 4B 0 D QsnQ5WSCSp 2A D QsnQ5R2 1A D QsnQ5WSCB1 1A D QsnQ5WSCB2 1A D QsnQ5WSCB3 1A D QsnQ5WSCB4 1A D QsnQ5WSCB5 1A D QsnQ5R3 5A D QsnQ5Prt 1A D QsnQ5R4 1A D QsnQ5GrdBf 1A D QsnQ5R5 9A *Note: this may be expanded in the future DQsnReadInf DS * Data structure for QsnRtvReadInf API. D QsnRIRet 10I 0 D QsnRIAvl 10I 0 D QsnRIR1 8A D QsnRIDta * D QsnRIFDta * D QsnRIDtaL 10I 0 D QsnRIFDtaL 10I 0 D QsnRINumF 10I 0 D ReadLen 10I 0 D QsnRIRow 10I 0 D QsnRICol 10I 0 D QsnRIAID 1A D QsnRIR2 7A DQsnFldInf DS * Data structure for QsnRtvFldInf API. D QsnFIRet 10I 0 D QsnFIAvl 10I 0 D QsnFIType 1A D QsnFIRow 10I 0 D QsnFICol 10I 0 D QsnFIFDtaL 10I 0 D QsnFIR1 11A D QsnFIDta * DQsnWinExtI DS * Data structure for QsnCrtWin API D QsnWEDta * D QsnWEChg * procptr D QsnWEDlt * procptr D QsnWECoord * procptr D QsnWEDraw * procptr D QsnWECur * procptr DQsnWinD DS * Data structures for QsnCrtWin and QsnChgWin APIs. D QsnWTopR 10I 0 D QsnWLeftC 10I 0 D QsnWNumR 10I 0 D QsnWNumC 10I 0 D QsnWMinR 10I 0 D QsnWMinC 10I 0 D QsnWMaxR 10I 0 D QsnWMaxC 10I 0 D QsnWFS 1A D QsnWAtrM1 1A D QsnWAtrM2 1A D QsnWAtrM3 1A D QsnWAtrC1 1A D QsnWAtrC2 1A D QsnWAtrC3 1A D QsnWShowB 1A D QsnWShowBA 1A D QsnWShowLA 1A D QsnWShowRA 1A D QsnWMsgL 1A D QsnWULCh 1A D QsnWTopCh 1A D QsnWURCh 1A D QsnWLCh 1A D QsnWRCh 1A D QsnWLLCh 1A D QsnWBotCh 1A D QsnWLRCh 1A D QsnWGUI 1A D QsnWFlg1 1A D QsnWFlg2 1A D QsnWR1 1A D QsnWBdrF 1A D QsnWTtlF 1A D QsnWTAtrM 1A D QsnWTAtrC 1A D QsnWR2 1A D QsnWR3 3A D QsnWTtlO 10I 0 D QsnWTtlL 10I 0 D QsnWR4 10I 0 DQsnRWinD DS * Data structure for QsnRtvWinD API. D QsnRWRet 10I 0 D QsnRWAvl 10I 0 D QsnRWTopR 10I 0 D QsnRWLeftC 10I 0 D QsnRWNumR 10I 0 D QsnRWNumC 10I 0 D QsnRWMinR 10I 0 D QsnRWMinC 10I 0 D QsnRWMaxR 10I 0 D QsnRWMaxC 10I 0 D QsnRWFS 1A D QsnRWAtrM1 1A D QsnRWAtrM2 1A D QsnRWAtrM3 1A D QsnRWAtrC1 1A D QsnRWAtrC2 1A D QsnRWAtrC3 1A D QsnRWShwB 1A D QsnRWShwBA 1A D QsnRWShwLA 1A D QsnRWShwRA 1A D QsnRWMsgL 1A D QsnRWULCh 1A D QsnRWTopCh 1A D QsnRWURCh 1A D QsnRWLCh 1A D QsnRWRCh 1A D QsnRWLLCh 1A D QsnRWBotCh 1A D QsnRWLRCh 1A D QsnRWGUI 1A D QsnRWFlg1 1A D QsnRWFlg2 1A D QsnRWR1 1A D QsnRWBdrF 1A D QsnRWTtlF 1A D QsnRWTAtrM 1A D QsnRWTAtrC 1A D QsnRWR2 1A D QsnRWR3 3A D QsnRWTtlO 10I 0 D QsnRWTtlL 10I 0 D QsnRWR4 10I 0 DQsnSsnExtI DS * Data structure for QsnCrtSsn API D QsnSEDta * D QsnSEChg * procptr D QsnSEDlt * procptr D QsnSECoord * procptr D QsnSEDraw * procptr D QsnSECur * procptr DQsnSsnD DS * Data structure for QsnCrtSsn and QsnChgSsn APIs D QsnSActn * procptr Dim(24) D QsnSTRow 10I 0 D QsnSLCol 10I 0 D QsnSNRows 10I 0 D QsnSNCols 10I 0 D QsnSRollA 10I 0 D QsnSShftA 10I 0 D QsnSISize 10I 0 D QsnSMSize 10I 0 D QsnSIncr 10I 0 D QsnSIRows 10I 0 D QsnSR1 1A D QsnSWrap 1A D QsnSR2 1A D QsnEBCDIC 1A D QsnSEcho 1A D QsnSLDsp 1A D QsnSCDsp 1A D QsnSShowC 1A D QsnSCmdAM 1A D QsnSCmdAC 1A D QsnSInLAM 1A D QsnSInLAC 1A D QsnSPmtO 10I 0 D QsnSPmtL 10I 0 D QsnSCmdO1 10I 0 D QsnSCmdL1 10I 0 D QsnSCmdO2 10I 0 D QsnSCmdL2 10I 0 D QsnSR4 20A DQsnRSsnD DS * Data structure for QsnRtvSsnD APIs D QsnRSRet 10I 0 D QsnRSAvl 10I 0 D QsnRSR1 8A D QsnRSActn * procptr Dim(24) D QsnRSTRow 10I 0 D QsnRSLCol 10I 0 D QsnRSNRows 10I 0 D QsnRSNCols 10I 0 D QsnRSRollA 10I 0 D QsnRSShftA 10I 0 D QsnRSISize 10I 0 D QsnRSMSize 10I 0 D QsnRSIncr 10I 0 D QsnRSIRows 10I 0 D QsnRSR2 1A D QsnRSWrap 1A D QsnRSR3 1A D QsnREBCDIC 1A D QsnRSEcho 1A D QsnRSLDsp 1A D QsnRSCDsp 1A D QsnRSShowC 1A D QsnRSCmdAM 1A D QsnRSCmdAC 1A D QsnRSInLAM 1A D QsnRSInLAC 1A D QsnRSPmtO 10I 0 D QsnRSPmtL 10I 0 D QsnRSCmdO1 10I 0 D QsnRSCmdL1 10I 0 D QsnRSCmdO2 10I 0 D QsnRSCmdL2 10I 0 D QsnRSR5 20A /endif d $SelFmts pr d 10A Dim(100) d 10I 0 d 100A d $PutRecords Pr d $PutRecord Pr d Record 10A const d Add 1A const d ReadScr 1A const d Lines s 78A dim(24) d length s 10i 0 d Q s 1 inz('''') D APIErrorDS DS D 10I 0 Inz( %Size( APIErrorDS ) ) D BytesAvail 10I 0 Inz( *Zero ) D MsgID 7 Inz( *Blanks ) D 1 Inz( X'00' ) D MsgDta 256 Inz( *Blanks ) * d InputData ds qualified d based(p_InputData) d Row 3U 0 d Col 3U 0 d AID 1A d Field 500A * * d dataout ds 256 qualified inz d F3 n overlay(dataout:1) d Choice 1 overlay(dataout:*next) **--------------------------------------------------------------- D FldDtaDS DS occurs(1000) D #FmtNam 10A D #FldNam 10A D #FldLen 5I 0 D #FldPlen 5I 0 D #FldDec 1 D #FldIO 1 D #FldAtr 1 D #FldDTUS 1 D #FldEdt 20A D #FldRow 10I 0 D #FldCol 10I 0 D #FldCom 1000A varying D SavFmt s 10A D #FFW s 2A D #FLEN s 5I 0 d screenatr s 1 d ssize s 4 0 d #GotFlds s 10i 0 D RTVFLDS PR N D $FilQul 20 Value D $NumFlds 10I 0 D $FldDtaDS Like(FldDtaDS) d #Fmts s 10A Dim(100) d fx s 10I 0 d Ans s 100A d z s 10I 0 d z1 s 10I 0 d zx s 10I 0 d main PR /free *INLR = *ON; main(); return; /end-free //###################################################// P main b d main PI /free $FilQul = $Fil + $lib; clear FldDtaDs ; %occur(FlddtaDS) = 1; *IN10 = RTVFLDS ($FilQul : #GotFlds : FldDtaDS); $SelFmts(#Fmts : fx : Ans); zx = 0; for z = 1 to 50; if %subst(Ans : z*2 -1 : 2) <> *blank; zx += 1; endif; endfor; if zx > 0; for z = 1 to 50; if %subst(Ans : z*2 -1 : 2) <> *blank; z1 += 1; select; when z1 = 1 and z1 = zx; $PutRecord(#Fmts(z) : '0':'1'); when z1 = 1 ; $PutRecord(#Fmts(z) : '0':'0'); when z1 = zx; $PutRecord(#Fmts(z) : '1':'1'); other; $PutRecord(#Fmts(z) : '1':'0'); endsl; endif; endfor; endif; return; /end-free p main e *-------------------------------------------------------- * $SelFmts( ): Show Screen1 (Remote files via FTP) * *-------------------------------------------------------- p $SelFmts B d $SelFmts PI d #Fmts 10A Dim(100) d fx 10I 0 d Ans 100A d cmdbuf s like(Qsn_Cmd_Buf_T) d inpbuf s like(Qsn_Inp_Buf_T) d prompt s 70A varying d NRF s 50 inz('** No Records Found **') d skipthis s n d len s 10I 0 d data s 132A varying d x s 10I 0 d Row s 3I 0 d Col s 3I 0 d Answer s 500A varying * D DS D SFmts 14 DIM(100) D SFmtx 10 OVERLAY(Sfmts:5) d RowFmt ds d srowfmt 1 14 d srow 1 4 d sfmt 5 14 d srowb 1 4B 0 * d InputData ds qualified d based(p_InputData) d Row 3U 0 d Col 3U 0 d AID 1A d Field 500A /free // ---------------------------------------------- // Create Input/Output buffers and clear them // ---------------------------------------------- cmdbuf = QsnCrtCmdBuf(100: 50: 0: *OMIT: *OMIT); inpbuf = QsnCrtInpBuf(200: 50: 0: *OMIT: *OMIT); QsnClrBuf( cmdbuf : *omit ); QsnClrBuf( inpbuf : *omit ); // ---------------------------------------------- // Add the "Clear Screen" command to the output // so that the terminal starts with an empty // screen. // ---------------------------------------------- QsnClrScr( *omit : cmdbuf : *omit : *omit ); // ---------------------------------------------- // Put a screen title in the output buffer // ---------------------------------------------- data = 'Select Records Formats to Display .'; QsnWrtDta( data : %len(data) : *omit : 1 : 40 - (%len(data)/2) // center : QSN_SA_HI : QSN_SA_HI : QSN_SA_WHT : QSN_SA_WHT : cmdbuf : *omit : *omit ); // ---------------------------------------------- // Put the records on rows 3+ of the output buf // ---------------------------------------------- row = 3; col = -9; fx = 0; #Fmts = *blank; // Sort the formats with input fields into screen order // This is to help alleviate the requirement // that input fields need to be in the proper order in the buffer for x = 1 to #Gotflds; %occur(FlddtaDS) = x; If #FmtNam <> SavFmt or x = #GotFlds ; SavFmt = #FmtNam; fx += 1; sFmt = #Fmtnam; sRowb = 0; if #FldIO = x'02' or #FldIO = x'04' or #FldIO = x'05' ; sRowb = #Fldrow; endif; sFmts(fx) = srowfmt; Endif; If #FmtNam = SavFmt; If sRowb < #Fldrow and #FldIO = x'02' or #FldIO = x'04' or #FldIO = x'05'; sRowb = #Fldrow; sFmts(fx) = srowfmt; Endif; Endif; endfor; sorta sFmts; fx = 0 ; for x = 1 to 100; If SFmtx(x) <> *blank ; fx += 1; #Fmts(fx) = sFmtx(x); col += 14; if col >= 69; col = 5; row +=1; Endif; // temp fix if row < 24 ; QsnWrtDta( sFmtx(x) : 10 : *omit : row : col : QSN_SA_NORM : QSN_SA_NORM : QSN_SA_GRN : QSN_SA_GRN : cmdbuf : *omit : *omit ); QsnSetFld( *omit : 2 : row : col -3 : QSN_FFW_ALPHA_SHIFT : *omit : 0 : QSN_SA_UL : QSN_SA_GRN_UL : cmdbuf : *omit : *omit ); endif; endif; endfor; // ---------------------------------------------- // Let the user know how to exit (color blue) // ---------------------------------------------- QsnWrtDta( 'F3=Exit' : %len('F3=Exit') : *omit : 23 : 2 : QSN_SA_HI : QSN_SA_NORM : QSN_SA_BLU : QSN_SA_GRN : cmdbuf : *omit : *omit ); // ---------------------------------------------- // put the "unlock keyboard" command into the // output buffer // ---------------------------------------------- QsnReadInp( QSN_CC1_MDTALL_CLRALL : QSN_CC2_UNLOCKBD : *omit : *omit : cmdbuf : *omit : *omit ); // ---------------------------------------------- // send the output buffer to the terminal, and // wait for input from the user // ---------------------------------------------- QsnPutGetBuf( cmdbuf: inpbuf: *omit: *omit); // ---------------------------------------------- // Get a pointer to the input data, and the // length of the input data. // ---------------------------------------------- p_InputData = QsnRtvDta( inpbuf: *omit: *omit ); Len = QsnRtvDtaLen(inpbuf: *omit: *omit) - %size(InputData.ROW) - %size(InputData.COL) - %size(InputData.AID); // ---------------------------------------------- // Copy the answer from the buffer // ---------------------------------------------- ans = *blank; if (Len > 0); Answer = %trimr( %subst( InputData.field: 1: len) ); ans = Answer; endif; // ---------------------------------------------- // Clean up the buffers, and return to caller // ---------------------------------------------- QsnDltBuf(cmdbuf: *omit); QsnDltBuf(inpbuf: *omit); %subst(dataout:1:1) = '0'; if (InputData.AID = QSN_F3); %subst(dataout:1:1) = '1'; endif; // return Variable return ; /end-free P E *-------------------------------------------------------- * $PutRecord(): Send a record to Screen * *-------------------------------------------------------- p $PutRecord B d $PutRecord PI d Record 10A const d Add 1A const d ReadScr 1A const d cmdbuf s like(Qsn_Cmd_Buf_T) d inpbuf s like(Qsn_Inp_Buf_T) d prompt s 70A varying d skipthis s n d len s 10I 0 d x s 10I 0 d Row s 3U 0 d y s 10I 0 d yx s 10I 0 * D DS D SFldss 12 DIM(1000) D SOcurs 10I 0 OVERLAY(SFldss:9) d RowCol ds d sfld 1 12 d srow 1 4 d scol 5 8 d socur 9 12 d srowb 1 4B 0 d scolb 5 8B 0 d socurb 9 12B 0 /free // ---------------------------------------------- // Create Input/Output buffers and clear them // ---------------------------------------------- cmdbuf = QsnCrtCmdBuf(100: 50: 0: *OMIT: *OMIT); inpbuf = QsnCrtInpBuf(200: 50: 0: *OMIT: *OMIT); QsnClrBuf( cmdbuf : *omit ); QsnClrBuf( inpbuf : *omit ); if add = '0'; // ---------------------------------------------- // Add the "Clear Screen" command to the output // so that the terminal starts with an empty // screen. // ---------------------------------------------- QsnClrScr( *omit : cmdbuf : *omit : *omit ); endif; exsr ShowFile; if Readscr = '0'; // ---------------------------------------------- // send the output buffer to the terminal, // ---------------------------------------------- QsnPutBuf( cmdbuf: *omit: *omit); else; // ---------------------------------------------- // put the "unlock keyboard" command into the // output buffer // ---------------------------------------------- QsnReadInp( QSN_CC1_MDTALL_CLRALL : QSN_CC2_UNLOCKBD : *omit : *omit : cmdbuf : *omit : *omit ); // ---------------------------------------------- // send the output buffer to the terminal, and // wait for input from the user // ---------------------------------------------- QsnPutGetBuf( cmdbuf: inpbuf: *omit: *omit); // ---------------------------------------------- // Get a pointer to the input data, and the // length of the input data. // ---------------------------------------------- p_InputData = QsnRtvDta( inpbuf: *omit: *omit ); Len = QsnRtvDtaLen(inpbuf: *omit: *omit) - %size(InputData.ROW) - %size(InputData.COL) - %size(InputData.AID); endif; QsnDltBuf(cmdbuf: *omit); QsnDltBuf(inpbuf: *omit); return ; begsr ShowFile; // For the record sort the occurances into row col sequence // then process the occurs in the sorted sequence. clear SFldss; yx = 0; for y = 1 to #Gotflds; %occur(FlddtaDS) = y; If #FmtNam = record; srowb = #FldRow; scolb = #FldCol; socurb = y; yx += 1; Sfldss(yx) = sfld; Endif; endfor; sorta Sfldss; for y = 1 to 1000; if SFldss(y) = *blank; iter; endif; %occur(FlddtaDS) = SOcurs(y); // ---------------------------------------------- // Put a field in the output buffer // ---------------------------------------------- // data = 'Select File to download and process.'; // Construct the fields to paint the screen // //*Field attribute. //*X'01' indicates Constant (see structure QDFFFCON, //*X'02' indicates Output (O), //*X'03' indicates Message (M), h (B), //*X'04' indicates Input (I), (P) //*X'05' indicates Both (B), //*X'06' indicates Hidden (H), and //*X'07' indicates Program to System (P) If #FmtNam = record; select; when #FldIO = x'01'; Select; when #FldDTUS = 'D'; #Fldlen = 8; #FldCom = 'dd/mm/yy'; when #FldDTUS = 'Y'; #Fldlen = 8; #FldCom = 'dd/mm/yy'; when #FldDTUS = 'T'; #Fldlen = 8; #FldCom = 'hh:mm:ss'; when #FldDTUS = 'U'; #Fldlen = 10; #FldCom = 'User_Name'; when #FldDTUS = 'S'; #Fldlen = 10; #FldCom = 'Sys_Name'; endsl; QsnWrtDta( %trim(#FldCom) : #FldLen : *omit : #FldRow : #FldCol +1 : QSN_SA_HI : QSN_SA_HI : QSN_SA_WHT : QSN_SA_WHT : cmdbuf : *omit : *omit ); when #FldIO = x'02' or #FldIO = x'04' or #FldIO = x'05' ; //* Keyboard shift and data type. //* X'00' indicates Alpha shift/character (A), //* X'01' indicates Alpha only (X), //* X'02' indicates Numeric shift (N), //* X'03' indicates Numeric only (Y), //* X'04' indicates Katakana (K), //* X'05' indicates Digits only (D), //* X'06' indicates Inhibit keyboard (I), //* X'07' indicates Signed numeric/zoned (S), //* X'08' indicates Binary (B), //* X'09' indicates Packed (P), //* X'0A' indicates Floating (F), //* X'0B' indicates DBCS (J), //* X'0C' indicates Open (O), X'0D' indicates Either (E), //* X'0E' indicates Numeric-only character (M), //* X'0F' indicates Graphic (G), //* X'10' indicates Date (L), //* X'11' indicates Time (T), and //* X'12' indicates Timestamp (Z) select; when #FLDIO = x'02'; #FFW = QSN_NO_FFW; when #Fldatr = x'00'; #FFW = QSN_FFW_ALPHA_SHIFT; when #Fldatr = x'01'; #FFW = QSN_FFW_ALPHA_ONLY; when #Fldatr = x'02'; #FFW = QSN_FFW_NUM_SHIFT; when #Fldatr = x'03'; #FFW = QSN_FFW_NUM_ONLY; when #Fldatr = x'04'; #FFW = QSN_FFW_KATA; when #Fldatr = x'05'; #FFW = QSN_FFW_DIGIT_ONLY; when #Fldatr = x'06'; #FFW = QSN_FFW_IO; when #Fldatr = x'07'; #FFW = QSN_FFW_SIGNED_NUMERIC; endsl; select; when #FldLen <> 0 ; #FLen = #FldLen; when #FldPLen <> 0 ; #FLen = #FldPLen; endsl; QsnSetFld( *omit : #FLen : #FldRow : #FldCol + 1 : #FFW : *omit : 0 : QSN_SA_UL : QSN_SA_GRN_UL : cmdbuf : *omit : *omit ); endsl; endif; endfor; endsr; /end-free P E