ibmi-brunch-learn

Announcement

Collapse
No announcement yet.

how can I force to signed numeric

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • how can I force to signed numeric

    Is there a way when creating table with sql I can force decimal values to signed rather than packed?


    PHP Code:
     c/Exec Sql                                 
     c
    + declare global temporary table workfile 
     c
    + (OrdCreated  char(01) ,                 
     
    c+  Quote       dec(7,0) ,                 
     
    c+  QuoteSeq    dec(3,0) ,                 
     
    c+  QuoteDate   dec(8,0) ,                 
     
    c+  OrderType   char(01) ,                 
     
    c+  ActOrder    dec(7,0) ,                 
     
    c+  ActOrdSeq   dec(3,0) ,                 
     
    c+  BillOrder   dec(7,0) ,                 
     ------------ 
    33 data records excluded -----
     
    c+  with replace                           
     c
    /End-Exec 

    thanks for the help
    jamie
    All my answers were extracted from the "Big Dummy's Guide to the As400"
    and I take no responsibility for any of them.

    www.code400.com

  • #2
    Re: how can I force to signed numeric

    yes you can,
    PHP Code:
     Quote       numeric(7,0
    DMW
    Hunting down the future ms. Ex DeadManWalks. *certain restrictions apply

    Comment


    • #3
      Re: how can I force to signed numeric

      Thats what im talkin about...You Rock!
      All my answers were extracted from the "Big Dummy's Guide to the As400"
      and I take no responsibility for any of them.

      www.code400.com

      Comment


      • #4
        Re: how can I force to signed numeric

        PHP Code:
        Select field1field2
        From File1
        Join File2 on 
        (Field3 Field4)
        Where File1.packedField File2.SignedField 

        Am I wrong to beleive that the fact that packedField and SignedField have different types will cause SQL engine to create a new index?

        Comment


        • #5
          Re: how can I force to signed numeric

          Jamie... are you still using formatted SQLRPGLE code?? Is that what I'm seeing??

          Why not the...

          /Exec SQL
          Select *
          From File
          Where condition;

          Used in /Free?

          I'm so shocked!!!

          Comment


          • #6
            Re: how can I force to signed numeric

            I really dont write any code anymore. I cut words and letters out of the Chicago sun times and paste then together to resemble RPG code.
            All my answers were extracted from the "Big Dummy's Guide to the As400"
            and I take no responsibility for any of them.

            www.code400.com

            Comment


            • #7
              Re: how can I force to signed numeric

              Jamie,
              This is a good one !

              ROTFL
              Philippe

              Comment


              • #8
                Re: how can I force to signed numeric

                Originally posted by FaStOnE View Post
                Jamie... are you still using formatted SQLRPGLE code?? Is that what I'm seeing??

                Why not the...

                /Exec SQL
                Select *
                From File
                Where condition;

                Used in /Free?

                I'm so shocked!!!
                Don't you need some PTF or else the latest and greatest OS release for that?
                Ben

                Comment


                • #9
                  Re: how can I force to signed numeric

                  is an add-on from microsoft to finally stick the sword in the head of the bull (IBM)
                  All my answers were extracted from the "Big Dummy's Guide to the As400"
                  and I take no responsibility for any of them.

                  www.code400.com

                  Comment


                  • #10
                    Re: how can I force to signed numeric

                    Hey Ben,

                    We're on v5r4 here for development. We just got our production box up to the same level. It's really nice to be able to compile without predicating prior release. Although, we were able to use the above format compiled for v5r3.

                    I think (and yes, that's a scary thought) that it does come with v5r4.

                    -Rick

                    Comment


                    • #11
                      Re: how can I force to signed numeric

                      sorry guys I thought we were still messin.

                      Yes only V5R4 but the compiled objects will run on V5R3 machines.

                      Code:
                           fBRC06INTADcf   e             workstn INFDS(INFDS)
                           f                                     SFILE(SUB01:RRN1)
                           f                                     SFILE(SUB02:RRN2)
                           fglccompa  if   e           k disk
                      
                            *
                            * Variable Definition
                            *
                           d decmdy          s              6  0
                           d dectime         s              6  0
                           d company         s              2s 0
                           d count           s              4  0
                           d dataqueue       s             10    inz('BR2BARCODE')
                           d dataqueueLib    s             10    inz('*LIBL')
                           d dataqueueLen    s              5  0 inz(4096)
                           d EndScreen1      s              1    inz('N')
                           d EndScreen2      s              1    inz('N')
                           d EndScreen3      s              1    inz('N')
                           d Format          s              8A   Inz('DEVD0600')
                           d fnd             s              3  0
                           d isodate         s               d
                           d LenStr          s              4  0
                           d mdy             s               d   datfmt(*mdy)
                           d messagecsc      s             10i 0
                           d messagedata     s             80A
                           d messagekey      s              4A
                           d messagelen      s             10i 0
                           d messagefile     s             20    inz('LBIMSG    *LIBL')
                           d messageid       s              7
                           d outcopies       s              4  0
                           d outhold         s              1
                           d outmode         s              1
                           d outprtf         s             10
                           d outtype         s              1
                           d QueueData       s           4096
                           d RcvVarLen       s             10i 0
                           d Rcvar           S           5000A   Inz
                           d RRN1            s                   like(SCRRN)
                           d RRN2            s                   like(SCRRN2)
                           d SaveID          s              9  0 inz
                           d Savrrn          s                   like(SCRRN)
                           d Savrrn2         s                   like(SCRRN2)
                           d screenerror     s              1    inz('N')
                           d sqlstmt         s          23000    varying
                           d start           s              2  0
                           d Varlen          S             10i 0 Inz(5000)
                           d workingoutq     s             10
                           d workTitle       s             40
                            //
                            // Program Info
                            //
                           d                SDS
                           d  @PGM                 001    010
                           d  @PARMS               037    039  0
                           d  @MSGDTA               91    170
                           d  @MSGID               171    174
                           d  @JOB                 244    253
                           d  @USER                254    263
                           d  @JOB#                264    269  0
                      
                            // Command Keys
                      
                           d Cmd01           c                   const(x'31')                         Cmd-1
                           d Cmd02           c                   const(x'32')                         Cmd-2
                           d LeaveProgram    c                   const(x'33')                         Cmd-3
                           d RetrieveLabel   c                   const(x'34')                         Cmd-4
                           d Cmd05           c                   const(x'35')                         Cmd-5
                           d Cmd06           c                   const(x'36')                         Cmd-6
                           d Cmd07           c                   const(x'37')                         Cmd-7
                           d PrintLabels     c                   const(x'38')                         Cmd-8
                           d SaveLabels      c                   const(x'39')                         Cmd-9
                           d CenterLine      c                   const(x'3A')                         Cmd-10
                           d Cmd11           c                   const(x'3B')                         Cmd-11
                           d Cmd12           c                   const(x'3C')                         Cmd-12
                           d Cmd13           c                   const(x'B1')                         Cmd-13
                           d Cmd14           c                   const(x'B2')                         Cmd-14
                           d Cmd15           c                   const(x'B3')                         Cmd-15
                           d Cmd16           c                   const(x'B4')                         Cmd-16
                           d Cmd17           c                   const(x'B5')                         Cmd-17
                           d Cmd18           c                   const(x'B6')                         Cmd-18
                           d Cmd19           c                   const(x'B7')                         Cmd-19
                           d Cmd20           c                   const(x'B8')                         Cmd-20
                           d Cmd21           c                   const(x'B9')                         Cmd-21
                           d Cmd22           c                   const(x'BA')                         Cmd-22
                           d Cmd23           c                   const(x'BB')                         Cmd-23
                           d Cmd24           c                   const(x'BC')                         Cmd-24
                           d EnterKey        c                   const(x'F1')
                           d RollUp          c                   const(x'F5')                         Roll Up
                           d ZollDown        c                   const(x'F4')                         Roll Down
                      
                           d Infds           ds                                                       INFDS data structure
                           d Choice                369    369
                           d Currec                378    379I 0
                      
                           d APIError        ds                  Qualified
                           d  BytesP                 1      4I 0 inz(%size(apiError))
                           d  BytesA                 5      8I 0 inz(0)
                           d  Messageid              9     15
                           d  Reserved              16     16
                           d  messagedta            17    256
                      
                           d lbldata       e ds                  extname(BRC04DS)
                           d                                     prefix(ds_)
                      
                           d sqldata       e ds                  extname(BRCgeneric)
                      
                            //
                            //  external called programs
                            //
                      
                           d $sendmsg        PR                  ExtPgm('QMHSNDPM')
                           d   MessageID                    7A   Const
                           d   QualMsgF                    20A   Const
                           d   MsgData                    256A   Const
                           d   MsgDtaLen                   10I 0 Const
                           d   MsgType                     10A   Const
                           d   CallStkEnt                  10A   Const
                           d   CallStkCnt                  10I 0 Const
                           d   Messagekey                   4A
                           d   ErrorCode                  256A
                      
                           d $clearmsg       pr                  extpgm('QMHRMVPM')
                           d   messageq                   276a   const
                           d   CallStack                   10i 0 const
                           d   Messagekey                   4a   const
                           d   messagermv                  10a   const
                           d   ErrorCode                  256
                      
                           d $SndDtaQ        pr                  extpgm('QSNDDTAQ')
                           d   DtaQName                    10
                           d   DtaQLib                     10
                           d   DataLenSent                  5  0
                           d   QueueData                 4096    options(*varsize)
                      
                           d $brc06          pr                  extpgm('BRC06')
                           d   QueueData                 4096    options(*varsize)
                      
                           d $titlecolor     pr                  extpgm('MSC08')
                           d   company                      2s 0
                           d   attribute                    1
                      
                           d $getipaddress   pr                  extpgm('QDCRDEVD')
                           d   rcvar                     5000
                           d   varlen                      10i 0
                           d   format                       8
                           d   @job                        10
                           d   apierror                   256
                      
                           d openList        pr
                           d FetchNext       pr              n
                           d closeList       pr
                      
                            /copy qpgmsrc,oen1ctrl
                            /copy qprcsrc,overprt_cp
                      
                            /Free
                      
                              //--------------------------------------------------------
                              // MAIN PROGRAM
                              //--------------------------------------------------------
                      
                                  exsr  Hskpg;
                                  exsr  $Screen1;
                      
                                  *inlr = *on;
                      
                              //--------------------------------------------------------
                              // $Screen1 - parameter screen
                              //--------------------------------------------------------
                                   begsr $Screen1;
                      
                                   reset  EndScreen1;
                                    dow  EndScreen1 = 'N';
                      
                                     if ScreenError = 'N';
                                      $clearmsg('*' : *zero : *Blanks : '*ALL' : APIError);
                                     endif;
                      
                                     write FKEY01;
                                     write HEAD01;
                                     write MSGCTL;
                                     exfmt SUB01CTL;
                                     $clearmsg('*' : *zero : *Blanks : '*ALL' : APIError);
                                     reset ScreenError;
                                     if Currec <> *Zeros;
                                      RRN1  =  Currec;
                                      SCRRN =  Currec;
                                     endif;
                      
                                     select;
                                  //
                                  // F3 pressed end the program F3 = LeaveProgram
                                  //
                                      when  Choice = LeaveProgram;
                                       EndScreen1 = 'Y';
                                  //
                                  // F4 pressed retrieve label information
                                  //
                                      when  Choice = retrievelabel;
                                       exsr $screen2;
                                  //
                                  // F8 pressed process to print the subfile
                                  //
                                      when  Choice = Printlabels;
                                       exsr $printLabels;
                                  //
                                  // F9 pressed save the label prompt for description
                                  //
                                      when  Choice = savelabels;
                                       exsr $savelabel;
                                  //
                                  // F10 pressed center all lines
                                  //
                                      when  Choice = centerline;
                                       exsr $centerline;
                                  //
                                  // Enter Key pressed
                                  //
                                      when  Choice = enterKey;
                                    // exsr $validate;
                      
                                      endsl;
                                     enddo;
                      
                                   endsr;
                      
                      
                              //----------------------------------------
                              // $clearSfl - clear the subfile
                              //----------------------------------------
                                   begsr $clearSFL;
                      
                                    // clear the subfile first
                      
                                     *in31 = *Off;
                                     *in32 = *Off;
                                     *in30 = *On;
                      
                                     write  SUB01CTL;
                      
                                     *in31 = *On;
                                     *in32 = *On;
                                     *in30 = *Off;
                      
                                     clear RRN1;
                                     clear SCRRN;
                                     clear SavRrn;
                      
                                   endsr;
                      
                              //--------------------------------------------------------
                              // $loadsfl- load up the entire subfile
                              //--------------------------------------------------------
                                   begsr $loadsfl;
                      
                                    if  SavRrn  > *zeros;
                                     RRN1  =  SavRrn;
                                     SCRRN =  SavRrn;
                                    endif;
                      
                                 // only allowed 7 lines of text
                      
                                     for count = 1 to 7;
                                      RRN1 += 1;
                                      SCRRN = RRN1;
                                      write SUB01;
                                     endfor;
                      
                                    *in33 = *on;
                                    savrrn = SCRRN;
                                 //
                                 //  If no records in subfile then do not disply the subfile.
                                 //
                                    if SavRrn  = *zeros;
                                     *in31 = *off;
                                    else;
                                     RRN1  = 1;
                                     SCRRN  = 1;
                                    endif;
                      
                                   endsr;
                              //--------------------------------------------------------
                              // $savelabel - save the label - need description
                              //--------------------------------------------------------
                                   begsr $savelabel;
                      
                      
                                     // get the 7 lines of text into variables
                      
                                    for count = 1 to 7;
                                     chain count SUB01;
                                     if %found(BRC06INTAD);
                      
                                      select;
                                       when count = 1;
                                        ds_text1  =  s1text;
                                       when count = 2;
                                        ds_text2  =  s1text;
                                       when count = 3;
                                        ds_text3  =  s1text;
                                       when count = 4;
                                        ds_text4  =  s1text;
                                       when count = 5;
                                        ds_text5  =  s1text;
                                       when count = 6;
                                        ds_text6  =  s1text;
                                       when count = 7;
                                        ds_text7  =  s1text;
                                      endsl;
                      
                                     endif;
                                    endfor;
                      
                                    // if h1id# > *zeros then this is an update
                                    // else write as new
                      
                                    reset endscreen2;
                                    clear w1desc;
                                     // now check to see if this label already created and we are just
                                     // updating...if this is the case then we need the description
                                    exec sql select BCDESC  into : w1desc
                                             from BRCGENERIC
                                             where BCLABEL_ID = :h1id#;
                                    h1desc = w1desc;
                      
                                    dow endscreen2 = 'N';
                                     exfmt SAVELABEL;
                                     select;
                                  //
                                  // F3 pressed end the program F3 = LeaveProgram
                                  //
                                      when  Choice = LeaveProgram;
                                       EndScreen2 = 'Y';
                                  //
                                  // Enter Key pressed
                                  //
                                      when  Choice = enterKey;
                                       if W1DESC <> *blanks;
                                        EndScreen2 = 'Y';
                                        if H1ID# > *zeros and  W1DESC = H1DESC;
                                         exec sql update brcgeneric
                                                  set BCLINE1 =  : ds_text1,
                                                      BCLINE2 =  : ds_text2,
                                                      BCLINE3 =  : ds_text3,
                                                      BCLINE4 =  : ds_text4,
                                                      BCLINE5 =  : ds_text5,
                                                      BCLINE6 =  : ds_text6,
                                                      BCLINE7 =  : ds_text7,
                                                      BCCHG_DATE = current date,
                                                      BCCHG_TIME = current time,
                                                      BCCHG_BY   = :@user
                                                      where BCLABEL_ID = :h1id#;
                      
                                        else;
                                         // insert new record....we have to update ALL current
                                         // subfile lines to this new ID# after insert.
                      
                                         if H1ID# <> *zeros;
                                          clear H1ID#;
                                         endif;
                      
                                         exec sql insert into brcgeneric
                                                  ( BCDESC,
                                                    BCLINE1,
                                                    BCLINE2,
                                                    BCLINE3,
                                                    BCLINE4,
                                                    BCLINE5,
                                                    BCLINE6,
                                                    BCLINE7,
                                                    BCENTER_BY   ,
                                                    BCchg_date   ,
                                                    BCchg_time   ,
                                                    BCchg_by
                                                  ) VALUES
                                                  (
                                                  : w1desc       ,
                                                  : ds_text1     ,
                                                  : ds_text2     ,
                                                  : ds_text3     ,
                                                  : ds_text4     ,
                                                  : ds_text5     ,
                                                  : ds_text6     ,
                                                  : ds_text7     ,
                                                  : @USER        ,
                                                  current date,
                                                  current time,
                                                  : @USER
                                                                  );
                      
                                         clear saveid;
                                         exec sql select BCLABEL_ID into :saveid
                                                  from BRCGENERIC
                                                  where BCDESC = :w1desc;
                      
                                         for count = 1 to 7;
                                          chain count SUB01;
                                          if %found(BRC06INTAD);
                                           h1id# = saveid;
                                           update sub01;
                                          endif;
                                         endfor;
                      
                                        endif;
                      
                                       endif;
                                      endsl;
                                    enddo;
                      
                                   endsr;
                              //--------------------------------------------------------
                              // $printLabels - Print all requested labels
                              //--------------------------------------------------------
                                   begsr $printlabels;
                      
                                    clear QueueData;
                                    ds_label = 'GENERIC';
                                    ds_USER = @user;
                                    ds_quantity  = C1qty;
                      
                                    for count = 1 to 7;
                                     chain count SUB01;
                                     if %found(BRC06INTAD);
                      
                                      // scan the text for keywords if found replace
                                      // &date  = current date
                                      // &time  = current time
                      
                                      fnd = %scan('&date'  : s1text);
                                      if fnd > *zeros;
                                       s1text = %trim(%subst(s1text:1:fnd-1)) +
                                                ' ' + %editc(decmdy:'Y')  + ' ' +
                                                %trim(%subst(s1text:fnd+6)) ;
                                      endif;
                      
                                      fnd = %scan('&time'  : s1text);
                                      if fnd > *zeros;
                                       s1text = %trim(%subst(s1text:1:fnd-1)) +
                                                ' ' + %editW(dectime:'  :  :  ')  + ' ' +
                                                %trim(%subst(s1text:fnd+6)) ;
                                      endif;
                      
                                      select;
                                       when count = 1;
                                        ds_text1  =  s1text;
                                       when count = 2;
                                        ds_text2  =  s1text;
                                       when count = 3;
                                        ds_text3  =  s1text;
                                       when count = 4;
                                        ds_text4  =  s1text;
                                       when count = 5;
                                        ds_text5  =  s1text;
                                       when count = 6;
                                        ds_text6  =  s1text;
                                       when count = 7;
                                        ds_text7  =  s1text;
                                      endsl;
                                     endif;
                                    endfor;
                      
                                   // only use override printer file to return parameters
                      
                                    outmode = 'N';
                                    outtype = *blanks;
                                    outprtf = 'BCLABELS';
                                    outcopies  = 1;
                                    outhold = 'N';
                                    retoverprt =
                                    overprt(outmode          :
                                            DACNUM           :
                                            @PGM             :
                                            outprtf          :
                                            outcopies        :
                                            workingoutq      :
                                            outhold           );
                      
                                    if MXOUTQ <> *blanks;
                                     ds_OutQ = MXOUTQ;
                                    else;
                                     ds_OutQ = 'QPRINT';
                                    endif;
                      
                                   // setup company name
                      
                                    clear ds_cmpinfo;
                                    chain (company) glccompa;
                                    if %found(glccompa);
                                     ds_cmpinfo  =  %trim(gccdes)  +
                                                    '   '          +
                                                    %trim(gcadd1)  +
                                                    '   '          +
                                                    %trim(gcadd2)  +
                                                    '   '          +
                                                    %trim(gccity)  +
                                                    ',  '          +
                                                    gcst           +
                                                    '   '          +
                                                    %trim(gczipcd) +
                                                    '   '          +
                                                    '(' + %editc(gcarea:'X') + ')' +
                                                    ' '            +
                                                    %subst(%editc(gcphon:'X'):1:3) +
                                                    '-' + %subst(%editc(gcphon:'X'):4:4);
                                    endif;
                      
                                    queuedata = lbldata;
                      
                                    $SndDtaQ (Dataqueue    :
                                              DataQueueLib :
                                              DataQueueLen :
                                              QueueData    );
                      
                                   endsr;
                      
                              //--------------------------------------------------------
                              // $centerline - center current line of subfile
                              //--------------------------------------------------------
                                   begsr $centerline;
                      
                      
                                     // get the 7 lines of text into variables
                      
                                    if where > *zeros;
                                     chain where SUB01;
                                     if %found(BRC06INTAD);
                                      start = ((%len(s1text) - %len(%trim(s1text)))/2)+1;
                                      %subst(s1text:start) = %trim(s1text);
                                      %subst(s1text:1:start-1) = *blanks;
                                      update sub01;
                                     endif;
                                    endif;
                      
                                   endsr;
                      
                      
                              //--------------------------------------------------------
                              // $Screen2 - display all available labels
                              //--------------------------------------------------------
                                   begsr $Screen2;
                      
                                   exsr $clearsfl2;
                                   exsr $loadsfl2;
                      
                                   reset  EndScreen2;
                                    dow  EndScreen2 = 'N';
                      
                                     if ScreenError = 'N';
                                      $clearmsg('*' : *zero : *Blanks : '*ALL' : APIError);
                                     endif;
                      
                                     write MSGCTL;
                                     write  FMT2;
                                     exfmt SUB02CTL;
                                     $clearmsg('*' : *zero : *Blanks : '*ALL' : APIError);
                      
                                     if Currec <> *Zeros;
                                      RRN2  =  Currec;
                                      SCRRN2 =  Currec;
                                     endif;
                      
                                     select;
                                  //
                                  // F3 pressed end the program F3 = LeaveProgram
                                  //
                                      when  Choice = LeaveProgram;
                                       EndScreen2 = 'Y';
                                  //
                                  // Enter Key pressed
                                  //
                                      when  Choice = enterKey;
                                       if where2 > *zeros;
                                        chain where2 SUB02;
                                        if %found(BRC06INTAD);
                                           // need to populate the field in subfile one
                      
                                           exec sql
                                            select *
                                               into :sqldata
                                               from brcgeneric
                                               where BCLABEL_ID = : H2id# ;
                      
                                         for count = 1 to 7;
                                          chain count sub01;
                                          if %found(brc06intad);
                                           select;
                                            when count = 1;
                                             s1text = BCLINE1;
                                            when count = 2;
                                             s1text = BCLINE2;
                                            when count = 3;
                                             s1text = BCLINE3;
                                            when count = 4;
                                             s1text = BCLINE4;
                                            when count = 5;
                                             s1text = BCLINE5;
                                            when count = 6;
                                             s1text = BCLINE6;
                                            when count = 7;
                                             s1text = BCLINE7;
                                           endsl;
                      
                                           h1id# = h2id#;     // save the label id number
                                           update sub01;
                      
                                          endif;
                                         endfor;
                      
                                         endscreen2 = 'Y';
                                        endif;
                                       endif;
                      
                                      endsl;
                                     enddo;
                      
                                   endsr;
                      
                      
                              //----------------------------------------
                              // $clearSfl2 -  clear the subfile
                              //----------------------------------------
                                   begsr $clearSFL2;
                      
                                    // clear the subfile first
                      
                                     *in35 = *Off;
                                     *in36 = *Off;
                                     *in34 = *On;
                      
                                     write  FMT2;
                                     write  SUB02CTL;
                      
                                     *in35 = *On;
                                     *in36 = *On;
                                     *in34 = *Off;
                      
                                     clear RRN2;
                                     clear SCRRN2;
                                     clear SavRrn2;
                      
                                   endsr;
                      
                              //--------------------------------------------------------
                              // $loadsfl2 - load up the entire subfile
                              //--------------------------------------------------------
                                   begsr $loadsfl2;
                      
                                    if  SavRrn2 > *zeros;
                                     RRN2  =  SavRrn2;
                                     SCRRN2 =  SavRrn2;
                                    endif;
                      
                                    sqlstmt = 'select * from brcgeneric order by  BCDESC ';
                                    openList();
                                    dow fetchNext();
                                     s2label = BCDESC;
                                     h2id# = BCLABEL_ID;
                                     RRN2 += 1;
                                     SCRRN2 = RRN2;
                                     write SUB02;
                                    enddo;
                                    closeList();
                                    *in37 = *on;
                                    savrrn2 = SCRRN2;
                                 //
                                 //  If no records in subfile then do not disply the subfile.
                                 //
                                    if SavRrn2 = *zeros;
                                     *in35 = *off;
                                    else;
                                     RRN2  = 1;
                                     SCRRN2 = 1;
                                    endif;
                      
                                   endsr;
                              //----------------------------------------
                              // $sendmessage - send the program message
                              //----------------------------------------
                                   begsr $sendmessage;
                      
                                    $sendmsg(messageID   :
                                             messageFile :
                                             messagedata :
                                             messageLen  :
                                             '*DIAG'     :
                                             @PGM        :
                                             messagecsc  :
                                             messagekey  :
                                             APIError
                                                         );
                      
                                   endsr;
                      
                              //--------------------------------------------------------
                              // Hskpg - one time run subroutine
                              //--------------------------------------------------------
                                   begsr Hskpg;
                      
                                    in   dactrl;
                                    company = DASRVC;
                                    PGMQ = @PGM;
                      
                                     workTitle = 'Print Generic Labels';
                                     LenStr =
                                     ((%len(workTitle) - %len(%trim(workTitle))) / 2) + 1;
                                     %subst(C1TITLE:LenStr) = %trim(workTitle);
                                     hdprogram = @PGM;
                      
                                     $getipaddress( rcvar   :
                                                    varlen  :
                                                    format  :
                                                    @job    :
                                                    Apierror
                                                             );
                                     ipaddress = %subst( rcvar:878:15);
                                     c1qty = 1;
                                     exsr $clearsfl;
                                     exsr $loadsfl;
                                     mdy = %date();
                                     decmdy = %dec(mdy);
                                     dectime = %dec(%time());
                      
                                   endsr;
                      
                            /End-Free
                            *--------------------------------------------------------
                            *  openList  - Open a cursor to read file
                            *--------------------------------------------------------
                           p openList        b
                      
                           d openList        pi
                      
                            /Free
                      
                             exec sql
                              declare MyCursor cursor for statement;
                      
                             exec sql
                              prepare statement from :sqlstmt;
                      
                             exec sql
                              open mycursor;
                      
                            /End-Free
                      
                           p openList        e
                            *--------------------------------------------------------
                            *  fetchNext  - read one record at a time
                            *--------------------------------------------------------
                           p fetchNext       b
                      
                           d fetchNext       pi              n
                      
                            /free
                      
                             exec sql
                              fetch next from mycursor into : sqldata;
                               if sqlstt < '02000';
                                 return *on;
                               else;
                                 return *off;
                               endif;
                      
                            /end-free
                      
                           p fetchNext       e
                            *--------------------------------------------------------
                            *  closeOrderList  - Close the OrderHdr cursor
                            *--------------------------------------------------------
                           p closeList       b
                      
                           d closeList       pi
                      
                            /free
                      
                             exec sql
                              close MyCursor;
                      
                            /end-free
                      
                           p closeList       e
                      All my answers were extracted from the "Big Dummy's Guide to the As400"
                      and I take no responsibility for any of them.

                      www.code400.com

                      Comment

                      Working...
                      X