pgm

   dcl   &ErrCod      *char    8     value( x'00000000' )
   dcl   &RtnVal      *char    2

   dcl   &LoLvlEnvD   *char   38
   dcl   &LoLvlEnvDL  *char    4
   dcl   &hLoLvlEnv   *char    4     value( x'00000000' )

   dcl   &AID         *char    1

   dcl   &hCmdBuf     *char    4

   dcl   &Data        *char  128
   dcl   &DataL       *char    4
   dcl   &FldId       *char    4
   dcl   &Row         *char    4
   dcl   &Column      *char    4
   dcl   &StrMAtr     *char    1
   dcl   &EndMAtr     *char    1
   dcl   &StrColAtr   *char    1
   dcl   &EndColAtr   *char    1

   dcl   &hCmdBuf     *char    4

   dcl   &WDRowUL     *char    4
   dcl   &WDColUL     *char    4
   dcl   &WDRow       *char    4
   dcl   &WDCol       *char    4
   dcl   &WDRowMin    *char    4
   dcl   &WDColMin    *char    4
   dcl   &WDRowMax    *char    4
   dcl   &WDColMax    *char    4
   dcl   &WDFulScnF   *char    1
   dcl   &WDMAtr      *char    3
   dcl   &WDColAtr    *char    3
   dcl   &WDBrdF      *char    1
   dcl   &WDBrdAtrF   *char    1
   dcl   &WDBrdLAtrF  *char    1
   dcl   &WDBrdCAtrF  *char    1
   dcl   &WDMsgLF     *char    1
   dcl   &WDBrdUL     *char    1
   dcl   &WDBrdTop    *char    1
   dcl   &WDBrdUC     *char    1
   dcl   &WDBrdL      *char    1
   dcl   &WDBrdC      *char    1
   dcl   &WDBrdLL     *char    1
   dcl   &WDBrdBot    *char    1
   dcl   &WDBrdLC     *char    1
   dcl   &WDGUIF      *char    1
   dcl   &WDGUIF1     *char    1
   dcl   &WDGUIF2     *char    1
   dcl   &WDResv1     *char    1
   dcl   &WDBrdFs     *char    1
   dcl   &WDTtlF      *char    1
   dcl   &WDMTtlAtr   *char    1
   dcl   &WDCTtlAtr   *char    1
   dcl   &WDResv2     *char    1
   dcl   &WDResv3     *char    3
   dcl   &WDOfsTtl    *char    4
   dcl   &WDTtlL      *char    4
   dcl   &WDResv4     *char    4
   dcl   &WDTtl       *char   80

   dcl   &hWin        *char    4

   dcl   &WinD        *char  156
   dcl   &WinDL       *char    4
   dcl   &UsrExtI     *char   96
   dcl   &UsrExtIL    *char    4
   dcl   &StrWin      *char    1


   chgvar      %bin( &WinDL )      ( 156 )

   callprc 'QsnInzWinD'     ( +
                              &WinD        +
                              &WinDL       +
                              &ErrCod      +
                            ) +
                      rtnval( +
                              %bin( &RtnVal ) +
                            )

   callprc 'QsnCrtCmdBuf'   ( +
             /* 300 */        x'0000012C'  +
             /*  20 */        x'00000014'  +
                              x'00000000'  +
                              *omit        +
                              *omit        +
                            ) +
                      rtnval( +
                              %bin( &hCmdBuf )  +
                            )


   chgvar      %bin( &WDRowUL    ) ( 4  )
   chgvar      %bin( &WDColUL    ) ( 8  )
   chgvar      %bin( &WDRow      ) ( 10 )
   chgvar      %bin( &WDCol      ) ( 10 )
   chgvar      %bin( &WDRowMin   ) ( 8  )
   chgvar      %bin( &WDColMin   ) ( 8  )
   chgvar      %bin( &WDRowMax   ) ( 16 )
   chgvar      %bin( &WDColMax   ) ( 40 )
   chgvar            &WDFulScnF      '0'
   chgvar            &WDMAtr         x'202220'
   chgvar            &WDColAtr       x'203A20'
   chgvar            &WDBrdF         '1'      /* '0' = No border */
   chgvar            &WDBrdAtrF      '1'      /* '0' = No border atr */
   chgvar            &WDBrdLAtrF     '1'      /* '0' = No border lead atr */
   chgvar            &WDBrdCAtrF     '1'      /* '0' = No border center atr */
   chgvar            &WDMsgLF        '1'      /* '0' = No message line */
   chgvar            &WDBrdUL        '+'      /* '.' is default */
   chgvar            &WDBrdTop       '-'      /* '.' is default */
   chgvar            &WDBrdUC        '.'      /* '.' is default */
   chgvar            &WDBrdL         '|'      /* ':' is default */
   chgvar            &WDBrdC         '='      /* '?' is default */
   chgvar            &WDBrdLL        '+'      /* ':' is default */
   chgvar            &WDBrdBot       '_'      /* '.' is default */
   chgvar            &WDBrdLC        '~'      /* ':' is default */
   chgvar            &WDGUIF         '1'      /* '0' = Do not use GUI */
   chgvar            &WDGUIF1        x'00'    /* Byte 5 */
   chgvar            &WDGUIF2        x'00'    /* Byte 6 */
   chgvar            &WDResv1        x'00'
   chgvar            &WDBrdFs        x'80'    /* Byte 3 */
   chgvar            &WDTtlF         x'00'    /* Byte 3 */
   chgvar            &WDMTtlAtr      x'21'    /* x'20' = default */
   chgvar            &WDCTtlAtr      x'21'    /* x'20' = default */
   chgvar            &WDResv2        x'00'
   chgvar            &WDResv3        x'000000'
   chgvar      %bin( &WDOfsTtl   ) ( 76 )
   chgvar      %bin( &WDTtlL     ) ( 5  )
   chgvar            &WDResv4        x'00000000'
   chgvar            &WDTtl          'Title'

   chgvar            &WinD      ( +
                                  &WDRowUL     *cat +
                                  &WDColUL     *cat +
                                  &WDRow       *cat +
                                  &WDCol       *cat +
                                  &WDRowMin    *cat +
                                  &WDColMin    *cat +
                                  &WDRowMax    *cat +
                                  &WDColMax    *cat +
                                  &WDFulScnF   *cat +
                                  &WDMAtr      *cat +
                                  &WDColAtr    *cat +
                                  &WDBrdF      *cat +
                                  &WDBrdAtrF   *cat +
                                  &WDBrdLAtrF  *cat +
                                  &WDBrdCAtrF  *cat +
                                  &WDMsgLF     *cat +
                                  &WDBrdUL     *cat +
                                  &WDBrdTop    *cat +
                                  &WDBrdUC     *cat +
                                  &WDBrdL      *cat +
                                  &WDBrdC      *cat +
                                  &WDBrdLL     *cat +
                                  &WDBrdBot    *cat +
                                  &WDBrdLC     *cat +
                                  &WDGUIF      *cat +
                                  &WDGUIF1     *cat +
                                  &WDGUIF2     *cat +
                                  &WDResv1     *cat +
                                  &WDBrdFs     *cat +
                                  &WDTtlF      *cat +
                                  &WDMTtlAtr   *cat +
                                  &WDCTtlAtr   *cat +
                                  &WDResv2     *cat +
                                  &WDResv3     *cat +
                                  &WDOfsTtl    *cat +
                                  &WDTtlL      *cat +
                                  &WDResv4     *cat +
                                  &WDTtl            +
                                )

 /* dmpclpgm */
   chgvar            &StrWin         '1'      /* '0' = Do not start window */

   callprc 'QsnCrtWin'      ( +
                              &WinD        +
                              &WinDL       +
                              x'00'        +
                              x'00000000'  +
                              &StrWin      +
                              x'00'        +
                              x'00000000'  +
                              &hWin        +
                              &ErrCod      +
                            ) +
                      rtnval( +
                              %bin( &RtnVal ) +
                            )

   callprc 'QsnSetCurWin'   ( +
                              &hWin        +
                              x'00000000'  +
                            ) +
                      rtnval( +
                              %bin( &RtnVal ) +
                            )

   callprc 'QsnSetEnvWinMod' ( +
                           /* &EnbWinMod */  +
                              '1'          +
                              *omit        +
                              *omit        +
                              *omit        +
                              *omit        +
                              *omit        +
                            ) +
                      rtnval( +
                              %bin( &RtnVal ) +
                            )


   chgvar            &Data         'Title'
   chgvar      %bin( &DataL )    ( 5  )
   chgvar      %bin( &FldId )    ( 0  )
   chgvar      %bin( &Row   )    ( 3  )
   chgvar      %bin( &Column )   ( 3  )
   chgvar            &StrMAtr      x'00'
   chgvar            &EndMAtr      x'00'
   chgvar            &StrColAtr    x'00'
   chgvar            &EndColAtr    x'00'

   callprc 'QsnWrtDta'      ( +
                              &Data        +
                              &DataL       +
                              &FldId       +
                              &Row         +
                              &Column      +
                              x'00'        +
                              x'00'        +
                              x'00'        +
                              x'00'        +
                              &hCmdBuf     +
                              x'00000000'  +
                              *omit        +
                            ) +
                      rtnval( +
                              %bin( &RtnVal ) +
                            )

   callprc 'QsnPutBuf'      ( +
                              &hCmdBuf     +
                              x'00000000'  +
                              *omit        +
                            ) +
                      rtnval( +
                              %bin( &RtnVal ) +
                            )

   callprc 'QsnRtvCurWin'   ( +
                              &hWin        +
                              x'00000000'  +
                            ) +
                      rtnval( +
                              %bin( &RtnVal ) +
                            )

Nxt_WinUsr:

   callprc 'QsnRszWinUsr'   ( +
                              &hWin        +
                              x'00000000'  +
                            ) +
                      rtnval( +
                              %bin( &RtnVal ) +
                            )

   callprc 'QsnMovWinUsr'   ( +
                              &hWin        +
                              x'00000000'  +
                            ) +
                      rtnval( +
                              %bin( &RtnVal ) +
                            )

   callprc 'QsnBeep'        ( +
                              *omit        +
                              *omit        +
                              *omit        +
                            ) +
                      rtnval( +
                              %bin( &RtnVal ) +
                            )
   callprc 'QsnGetAID'      ( +
                              &AID         +
                              x'00000000'  +
                              x'00000000'  +
                            ) +
                      rtnval( +
                              &RtnVal       +
                            )

   if ( &AID *eq '1' )  +
      goto  Nxt_WinUsr  /* If simply <Enter>, go back again... */


   callprc 'QsnEndWin'      ( +
                              &hWin        +
                              '1'          +
                              x'00000000'  +
                            ) +
                      rtnval( +
                              %bin( &RtnVal ) +
                            )

   callprc 'QsnDltEnv'      ( +
                              &hWin        +
                              &ErrCod      +
                            ) +
                      rtnval( +
                              %bin( &RtnVal ) +
                            )

   return

endpgm