QDFRTVFD — Retrieve Display File Description

From MidrangeWiki
Revision as of 19:10, 13 December 2018 by DaveLClarkI (talk | contribs)
Jump to: navigation, search



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 on 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 documention 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 retreival 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 archane 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 reformated 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


#top



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                    4000A   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                    4000A   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

#top

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(6000)

     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(6000)
     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 6000;

            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





#top