1. This site uses cookies. By continuing to use this site, you are agreeing to our use of cookies. Learn More.

  2. Anuncie Aqui ! Entre em contato fdantas@4each.com.br
Cookies Anuncie aqui Patrocinador Anuncios

Urgente UPC DATASUl - PD4000

Discussão em 'Progress 4GL' iniciado por Neivaldo, Janeiro 17, 2020.

  1. Neivaldo

    Neivaldo Membro Participativo

    Pessoal bom dia,

    Preciso criar uma UPC no PD400 para pegar o numero do pedido (Nr-PedCli) quando crio um novo pedido, para assim que concluir a digitação do pedido, inclusive itens, acertar a informação de Unidade de Negócio através de um update no pedido.

    O problema é que nunca fiz uma UPC e estou perdido.

    Alguém tem algum código de exemplo que possa me ajudar?

    Desde já agradeço o apoio.

    Neivaldo
    Neivaldo, Janeiro 17, 2020
    #1
  2. bootstrapmaster

    bootstrapmaster Moderator Moderador Equipe de Suporte

    Código:
    /*****************************************************************************
**    Programa.:  upc-pd4000.p
**    Objetivo.:  UPC para Implantacao de Pedido - PD4000
**                validar o Campo Tipo de Pedido**              
**    Data.....:  Junho de 2004
**    Versoes..:  15/10/2004 - Substituido validacao de quantidades
**                             com base na tabela de Parametros Complementares
**                             por validacao baseada da tasbela de Lote PadrÆo
*****************************************************************************/

/*********************** Definicao de Parametros *************************/
DEFINE INPUT PARAMETER p-ind-event               AS CHARACTER      NO-UNDO.
DEFINE INPUT PARAMETER p-ind-object              AS CHARACTER      NO-UNDO.
DEFINE INPUT PARAMETER p-wgh-object              AS HANDLE         NO-UNDO.
DEFINE INPUT PARAMETER p-wgh-frame               AS WIDGET-HANDLE  NO-UNDO.
DEFINE INPUT PARAMETER p-cod-table               AS CHARACTER      NO-UNDO.
DEFINE INPUT PARAMETER p-row-table               AS ROWID          no-undo.
DEFINE VAR h-frame                               AS WIDGET-HANDLE  NO-UNDO.
DEFINE VAR h-frame2                              AS WIDGET-HANDLE  NO-UNDO.
DEFINE VAR h-frame3                              AS WIDGET-HANDLE  NO-UNDO.
DEFINE VAR h-frame4                              AS WIDGET-HANDLE  NO-UNDO.
DEFINE VAR h-frame5                              AS WIDGET-HANDLE  NO-UNDO.


/******************** Defini‡Æo de Variaveis Globais *********************/


DEFINE NEW GLOBAL SHARED VAR wgh-menu             AS HANDLE         NO-UNDO.
DEFINE NEW GLOBAL SHARED VAR wgh-tp-pedido        AS HANDLE         NO-UNDO.

DEFINE NEW GLOBAL SHARED VAR wgh-principal        AS HANDLE         NO-UNDO.
DEFINE NEW GLOBAL SHARED VAR i-ep-codigo-usuario  AS character      no-undo.
DEFINE NEW GLOBAL SHARED VAR wh-nome-abrev        AS HANDLE         NO-UNDO.
DEFINE NEW GLOBAL SHARED VAR wh-nr-pedcli         AS HANDLE         NO-UNDO.
DEFINE NEW GLOBAL SHARED VAR wh-tipo-pedido       AS HANDLE         NO-UNDO.
DEFINE NEW GLOBAL SHARED VAR wh-cod-estabel       as handle         no-undo.
DEFINE NEW GLOBAL SHARED VAR wh-container         as handle         no-undo.

DEFINE NEW GLOBAL SHARED VAR p-row-ped-venda      AS ROWID          NO-UNDO.
DEF    NEW GLOBAL SHARED VAR wgh-qt-log-aloca     AS HANDLE         NO-UNDO.

DEF    NEW GLOBAL SHARED VAR wgh-qt-un-uc         AS HANDLE         NO-UNDO.
DEFINE NEW GLOBAL SHARED VAR txt-qt-uc            AS HANDLE         NO-UNDO.
DEF    NEW GLOBAL SHARED VAR wh-quantidade        AS HANDLE         NO-UNDO.
DEFINE NEW GLOBAL SHARED VAR wgh-item             AS HANDLE         NO-UNDO.
DEF    NEW GLOBAL SHARED VAR wgh-qt-pedida        AS HANDLE         NO-UNDO.
DEF    NEW GLOBAL SHARED VAR wgh-it-codigo        AS HANDLE         NO-UNDO.
define new global shared variable w-cod-canal-venda as handle       no-undo.


DEF    NEW GLOBAL SHARED VAR wgh-bt-cancel-item   AS HANDLE         NO-UNDO.
DEF    NEW GLOBAL SHARED VAR wgh-bt-save-item     AS HANDLE         NO-UNDO.
DEF    NEW GLOBAL SHARED VAR wgh-bt-delete-order  AS HANDLE         NO-UNDO.
DEFINE NEW GLOBAL SHARED VAR wgh-bt-Complete-Ord  AS HANDLE         NO-UNDO.
DEFINE NEW GLOBAL SHARED VAR wgh-bt-save-ord      AS HANDLE         NO-UNDO.
DEFINE NEW GLOBAL SHARED VAR wgh-bt-save          AS HANDLE         NO-UNDO.
DEF                      VAR v-ped-venda          AS ROWID          NO-UNDO.
DEF                      VAR c-objeto             AS CHAR           NO-UNDO.


define new global shared variable btCompleteOrderNew as handle      no-undo.

define variable btOrderParameters                 as handle         no-undo.
define variable btPrecoFamilia                    as handle         no-undo.
define variable btPrecoPerfil                     as handle         no-undo.
define variable btVendaInterna                    as handle         no-undo.

/************************** Incio do Programa ***************************/

ASSIGN c-objeto = entry(num-entries(p-wgh-object:private-data,"~/"), p-wgh-object:private-data,"~/").

/* message "Evento: " p-ind-event skip                     */
/*         "Objeto: " p-ind-object skip                    */
/*         "Nome Obj: " c-objeto skip                      */
/*         "Frame " p-wgh-frame:NAME skip                  */
/*          "Tabela " p-cod-table skip                     */
/*         "Rowid " string(p-row-table) view-as alert-box. */


if p-ind-event  = "AFTER-DISPLAY" and
   p-ind-object = "container"     then do:

    run utils/findWidget.p ("cod-canal-venda",
                            "fill-in",
                            p-wgh-frame,
                            output w-cod-canal-venda).
END.


if p-ind-event = "AfterDisplayOrder" THEN do:
   FIND ped-venda NO-LOCK
        WHERE ROWID(ped-venda) = p-row-table
              NO-ERROR.
   IF AVAIL ped-venda THEN
      ASSIGN v-ped-venda = ROWID(ped-venda).
END.

if p-ind-object = 'container' then do:
    run utils/findWidget.p('btOrderParameters',
                           'button',
                           p-wgh-frame,
                           output btOrderParameters).
    run utils/findWidget.p('btPrecoFamilia',
                           'button',
                           p-wgh-frame,
                           output btPrecoFamilia).
    run utils/findWidget.p('btPrecoPefil',
                           'button',
                           p-wgh-frame,
                           output btPrecoPerfil).
    run utils/findWidget.p('btVendaInterna',
                           'button',
                           p-wgh-frame,
                           output btVendaInterna).
    if valid-handle(btOrderParameters) and
       not valid-handle(btPrecoPerfil) then do:
            create button btPrecoPerfil
                assign frame       = btOrderParameters:frame
                       name        = 'btPrecoPerfil'
                       help        = 'Informar pre‡os quilo por perfil'
                       tooltip     = 'Pre‡o Perfil'
                       width       = btOrderParameters:width
                       height      = btOrderParameters:height
                       row         = btOrderParameters:row
                       col         = btOrderParameters:col + 35
                       flat-button = btOrderParameters:flat-button
                       visible     = yes
                       label       = 'PPP'
                       sensitive   = yes.
                      
            if valid-handle(btPrecoPerfil) then do:
                btPrecoPerfil:load-image('image/im-pcust.bmp').

                if not btPrecoPerfil:flat-button then
                    btPrecoPerfil:move-before-tab(btOrderParameters).
            end.
            on 'choose' of btPrecoPerfil persistent run cstp/cspd4001.w.
    end.

    if valid-handle(btOrderParameters) and
       not valid-handle(btPrecoFamilia) then do:
            create button btPrecoFamilia
                assign frame       = btOrderParameters:frame
                       name        = 'btPrecoFamilia'
                       help        = 'Informar pre‡os unitarios por familia'
                       tooltip     = 'Pre‡o Familia'
                       width       = btOrderParameters:width
                       height      = btOrderParameters:height
                       row         = btOrderParameters:row
                       col         = btOrderParameters:col + 30
                       flat-button = btOrderParameters:flat-button
                       visible     = yes
                       label       = 'PPF'
                       sensitive   = yes.
                      
            if valid-handle(btPrecoFamilia) then do:
                btPrecoFamilia:load-image('image/im-orct2.bmp').

                if not btPrecoFamilia:flat-button then
                    btPrecoFamilia:move-before-tab(btOrderParameters).
            end.
            on 'choose' of btPrecoFamilia persistent run cstp/cspd4000.w.
    end.
    if valid-handle(btOrderParameters) and
       not valid-handle(btVendaInterna) then do:
            create button btVendaInterna
                assign frame       = btOrderParameters:frame
                       name        = 'btVendaInterna'
                       help        = 'Efetuar Venda interna'
                       tooltip     = 'Venda Interna'
                       width       = btOrderParameters:width
                       height      = btOrderParameters:height
                       row         = btOrderParameters:row
                       col         = btOrderParameters:col + 25
                       flat-button = btOrderParameters:flat-button
                       visible     = yes
                       label       = 'VIN'
                       sensitive   = yes.
                      
            if valid-handle(btVendaInterna) then do:
                btVendaInterna:load-image('image/im-carg.bmp').

            end.

            on 'choose' of btVendaInterna persistent run cstp/csvi020.w.
    end.

end.

IF p-ind-object = "container" THEN DO:
    ASSIGN wh-container    = p-wgh-object.
    if valid-handle(p-wgh-frame) then do:
        assign h-frame = p-wgh-frame:first-child.
        do while h-frame <> ?:
            if h-frame:type = "field-group" OR
               h-frame:type = "frame" OR
               h-frame:type BEGINS "menu" then do:
                ASSIGN h-frame2 = h-frame:first-child.
                do while h-frame2 <> ?:
                    IF h-frame2:NAME = "nome-abrev"  THEN ASSIGN wh-nome-abrev  = h-frame2.
                    IF h-frame2:NAME = 'Nr-pedcli'  THEN ASSIGN wh-nr-pedcli   = h-frame2.
                    ASSIGN h-frame2 = h-frame2:next-sibling.
                end.
            end.
            ASSIGN h-frame = h-frame:next-sibling.
        end.
    end.
end.


IF p-ind-event = "before-display"  THEN DO:
    ASSIGN h-frame = p-wgh-frame:first-child.
    do while h-frame <> ?:

        if h-frame:type = "field-group" OR
           h-frame:type = "frame" OR
           h-frame:type BEGINS "menu" THEN do:
            ASSIGN h-frame2 = h-frame:first-child.
            do while h-frame2 <> ?:
                if h-frame2:type = "field-group" OR
                   h-frame2:type = "frame" OR
                   h-frame2:type BEGINS "menu" THEN do:
                    ASSIGN h-frame3 = h-frame2:first-child.
                    do while h-frame3 <> ?:
                        if h-frame3:type = "field-group" OR
                           h-frame3:type = "frame"       OR
                           h-frame3:type BEGINS "menu" THEN do:
                            ASSIGN h-frame4 = h-frame3:first-child.
                            do while h-frame4 <> ?:
                               IF h-frame2:NAME = "fpage4" THEN DO:
                                  IF h-frame4:name = "tp-pedido" THEN DO:
                                     find ped-venda no-lock where
                                          rowid(ped-venda) = p-row-table no-error.

                                     if avail ped-venda THEN
                                        ASSIGN p-row-ped-venda = rowid(ped-venda).

                                     ASSIGN wgh-tp-pedido  = h-frame4.
                                  END.
                               END.

                               if h-frame2:name = 'fpage6' THEN ASSIGN wgh-item = h-frame2.
                               IF h-frame4:NAME = 'qt-log-aloca'    THEN ASSIGN wgh-qt-log-aloca    = h-frame4
                                                                                wgh-item            = wgh-qt-log-aloca:FRAME.
                               IF h-frame4:NAME = 'qt-pedida'          THEN ASSIGN wgh-qt-pedida       = h-frame4.
                               if h-frame4:name = 'btCompleteOrder'    THEN ASSIGN wgh-bt-complete-ord = h-frame4.
                               if h-frame4:name = 'btCompleteOrderNew' THEN ASSIGN btCompleteOrderNew  = h-frame4.
                               if h-frame4:name = 'btsaveorder'        THEN ASSIGN wgh-bt-save-ord     = h-frame4.
                               IF h-frame4:NAME = 'btDeleteOrder'      THEN ASSIGN wgh-bt-delete-order = h-frame4.
                               if h-frame4:name = 'cod-estabel'        THEN ASSIGN wh-cod-estabel      = h-frame4.
                               IF h-frame4:NAME = 'tp-pedido'          THEN ASSIGN wh-tipo-pedido      = h-frame4.
                               IF h-frame4:NAME = 'It-Codigo'          THEN ASSIGN wgh-it-codigo       = h-frame4.
                               IF h-frame4:NAME = 'btCancelItem'       THEN ASSIGN wgh-bt-cancel-item  = h-frame4.
                               IF h-frame4:NAME = 'btSaveItem'         THEN ASSIGN wgh-bt-save-item    = h-frame4.
                               ASSIGN h-frame4 = h-frame4:next-sibling.
                            end.
                        end.
                        ASSIGN h-frame3 = h-frame3:next-sibling.
                    end.
                end.
                ASSIGN h-frame2 = h-frame2:next-sibling.
            end.
        end.
        ASSIGN h-frame = h-frame:next-sibling.

        IF NOT VALID-HANDLE(wgh-qt-un-uc) THEN DO:
           create text txt-qt-uc
           ASSIGN frame = wgh-item  /*wgh-item*/
                  format       = "x(9)"
                  width        = 8
                  height       = .88
                  screen-value = 'Qt Un Com:'
                  row          =  wgh-qt-log-aloca:ROW
                  col          = 36.1
                  visible      = yes.


           create fill-in wh-quantidade
           ASSIGN frame            =  wgh-item
                 data-type        = 'decimal'
                 name              = 'qt-un-uc'
                 format            = '>>>>>9.99'
                 width             = 10
                 height            = .88
                 row               = wgh-qt-log-aloca:ROW
                 col               = 44.2
                 side-label-handle = txt-qt-uc
                  label            = 'Qt Un Com:'
                 screen-value      = ""
                 sensitive         = NO
                 visible           = yes
                 tooltip           = "QT Unid Com:"
                 help              = "QT Unid Com:".
        END.

    end.

    if valid-handle(wgh-bt-complete-ord) then do:
        if not valid-handle(btCompleteOrderNew) then do:
            create button btCompleteOrderNew
                assign frame       = wgh-bt-complete-ord:frame
                       name        = 'btCompleteOrderNew'
                       help        = wgh-bt-complete-ord:help
                       tooltip     = wgh-bt-complete-ord:tooltip
                       width       = wgh-bt-complete-ord:width
                       height      = wgh-bt-complete-ord:height
                       row         = wgh-bt-complete-ord:row
                       col         = wgh-bt-complete-ord:col
                       flat-button = wgh-bt-complete-ord:flat-button
                       visible     = wgh-bt-complete-ord:visible
                       label       = wgh-bt-complete-ord:label
                       sensitive   = wgh-bt-complete-ord:sensitive.
            btCompleteOrderNew:load-image(wgh-bt-complete-ord:image).
            btCompleteOrderNew:load-image-insensitive(wgh-bt-complete-ord:image-insensitive).

            if not btCompleteOrderNew:flat-button then btCompleteOrderNew:move-before-tab(wgh-bt-complete-ord).

            on 'choose' of btCompleteOrderNew persistent run pdupc/upc-pd4000CON.p(wgh-bt-complete-ord, wh-nome-abrev, wh-nr-pedcli).
        end.

    end.
end.

if valid-handle(btCompleteOrderNew)  and
   valid-handle(wgh-bt-complete-ord) then do:
    assign btCompleteOrderNew :sensitive = yes
           wgh-bt-complete-ord:sensitive = no
           wgh-bt-complete-ord:visible   = no.
end.

IF VALID-HANDLE(wgh-qt-pedida) and
   VALID-HANDLE(wh-quantidade) then
   wh-quantidade:move-after-tab-item(wgh-qt-pedida:handle).

IF VALID-HANDLE(wgh-qt-log-aloca) THEN
    ASSIGN wgh-qt-log-aloca:VISIBLE = NO.
    
if p-ind-event = 'before_pi-enableitem' THEN DO:
   ASSIGN wh-quantidade:LABEL = "QT Unid Com:"
          wh-quantidade:SENSITIVE = YES.
END.

if p-ind-event = "AfterDisplayItem" THEN DO:
   ASSIGN wh-quantidade:LABEL = "QT Unid Com:"
          wh-quantidade:SCREEN-VALUE = ''.
   IF VALID-HANDLE(wgh-it-codigo ) THEN DO:
       FIND FIRST ITEM USE-INDEX codigo WHERE
            ITEM.it-codigo = wgh-it-codigo :SCREEN-VALUE
            NO-LOCK NO-ERROR.

       IF AVAIL ITEM THEN DO:
          FIND FIRST Esp_Par_Com_GerIt USE-INDEX Esp_Par_ComGerIt WHERE
               Esp_Par_Com_GerIt.it_codigo = ITEM.it-codigo
               NO-LOCK NO-ERROR.
          IF AVAIL esp_par_com_gerIt THEN DO:
             ASSIGN wh-quantidade:SCREEN-VALUE  = STRING(decimal(wgh-qt-pedida:SCREEN-VALUE) / Esp_Par_Com_GerIt.Peso_Padrao_Uc) .
          END.
       END.
    END.
END.
  
IF VALID-HANDLE(wgh-bt-save-ord) THEN DO:
   ON 'choose':U OF wgh-bt-save-ord PERSISTENT
       RUN pdupc/upc-pd4000a.p.
END.

IF VALID-HANDLE(wgh-qt-pedida) THEN DO:
   ON 'leave':U OF wgh-qt-pedida PERSISTENT
      RUN pdupc/upc-pd4000b.p.
END.

IF VALID-HANDLE(wgh-bt-cancel-item) THEN DO:
   on 'choose':U of wgh-bt-cancel-item persistent
       run pdupc/upc-pd4000c.p.
END.

IF VALID-HANDLE(wgh-bt-save-item) THEN DO:
   ON 'Choose':U OF wgh-bt-save-item PERSISTENT
      RUN pdupc/upc-pd4000e.p.
END.

IF VALID-HANDLE(wh-quantidade) THEN DO:
   ON 'leave':U OF wh-quantidade PERSISTENT
      RUN pdupc/upc-pd4000f.p.
END.

IF VALID-HANDLE(wgh-bt-delete-order) THEN DO:
   ON 'Choose':U OF wgh-bt-delete-order PERSISTENT
      RUN pdupc/upc-pd4000g.p.
END.
    bootstrapmaster, Janeiro 17, 2020
    #2
  3. Neivaldo

    Neivaldo Membro Participativo


    Obrigado Richard,

    Você me ajudou bastante.

    Você tem a procurure findWidget.p ??

    Também preciso dela

    Att
    Neivaldo
    Neivaldo, Janeiro 22, 2020
    #3
  4. bootstrapmaster

    bootstrapmaster Moderator Moderador Equipe de Suporte

    verdade, esqueci dela ...
    Código:
    /***
*
* PROGRAMA:
*   upc/findWidget.p
*
* FINALIDADE:
*   Procedure para encontrar um widget em um frame
*
* PARAMETROS:
*   c-widget-name:  nome do widget a ser localizado
*   c-widget-type:  tipo do widget a ser localizado
*   h-start-widget: container para procurar o widget
*   h-widget:       widget encontrado
*
*/

define input  parameter c-widget-name  as char   no-undo.
define input  parameter c-widget-type  as char   no-undo.
define input  parameter h-start-widget as handle no-undo.
define output parameter h-widget       as handle no-undo.

do while valid-handle(h-start-widget):

    if h-start-widget:type = c-widget-type and
       (h-start-widget:name = c-widget-name or
        (h-start-widget:type = 'LITERAL':u and
         h-start-widget:screen-value = c-widget-name)) then do:

        assign h-widget = h-start-widget:handle.

        leave.
    end.

    if h-start-widget:type = "field-group":u or
       h-start-widget:type = "frame":u or
       h-start-widget:type = "dialog-box":u then do:

        run utils/findWidget.p (input  c-widget-name,
                                input  c-widget-type,
                                input  h-start-widget:first-child,
                                output h-widget).

        if valid-handle(h-widget) then
            leave.
    end.

    assign h-start-widget = h-start-widget:next-sibling.
end.
    bootstrapmaster, Janeiro 22, 2020
    #4

Compartilhe esta Página