ibmi-brunch-learn

Announcement

Collapse
No announcement yet.

QCMDEXC question

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

  • QCMDEXC question

    I'm trying to use callP to call QCMDEXC but the program doesn't compile. I defined the prototype on the D-specs as follows:

    D Cmd PR ExtPgm('QCMDEXC')
    D command 200a Const
    D length 15p 5 Const


    When trying to compile, the error message RNF5410-'The prototype for the call is not defined.' is received and stops the compile.

    Any suggestions??


    Thanks in adance.

  • #2
    Re: QCMDEXC question

    Here is an example of QCMDEXC Scan for QCMDEXC and command (down in *INZSR).

    Code:
         fHGQPGRP   If   E           K DISK
         fHGQPMATL  If   E           K DISK
         fHGQPPROC  If   E           K DISK
         fHGQPPARM  If   E           K DISK
         fHGQPVMSG  If   E           K DISK
         fHGCIREL   If   E           K DISK
         fHGQPDMSG  If   E           K DISK
         fHGPROD    If   E           K DISK
         fHGBRNSPD  If   E           K DISK
         fOERRPCSA  If   E           K DISK
         fINMINVTB  If   E           K DISK    rename(INMINVTR:FormatB)
         fINMINVTX  If   E           K DISK    usropn
         fInDescA   if   e           k disk
         fOEQOPDSA  if   e           k disk
         fCICADLBD  uf a e           k disk    rename(CICADLBR:D) prefix(D_) usropn
         fCIBCUSTOM if a E           K DISK    usropn
         fCIBCUSTOMAIf   e           k disk    rename(CIBCUSTOMR:CUSTOMA) prefix(A)
         f                                     usropn
         fCICADLB   O    E           K DISK    usropn
         fCIDSPEC   O    E           K DISK    usropn
         fCIHRELEAS O    E           K DISK    usropn
         fXREF$PRC  uf a e           k disk    usropn
         fNOPRICE   O    E           K DISK    usropn
         fXREFPROD  if   E           K DISK
          *
          * Program Info
          *
         d                SDS
         d  @PGM                   1     10
         d  @PARMS                37     39  0
         d  @JOB                 244    253
         d  @USER                254    263
         d  @JOB#                264    269  0
          *
          * Definitions
          *
         d BurnInches      s                   like(CCBRNIPP)
         d CmdLength       s             15  5
         d CmdString       s            256
         d Count           s              5  0
         d Dec3            s              3  0
         d Fourfour        s              4  4
         d Freight         s              7  2
         d ISODate         s               d   datfmt(*ISO)
         d LastPartName    s             15
         d LengthDec       s              5  5
         d NextPart#       s              7  0
         d OenCustomer     s              5  0
         d OenFrcCity      s             16
         d OenFrcState     s              2
         d OenInd          s              1
         d OenLotRate      s              7  2
         d OenRate         s              7  2
         d OenShipto       s              5  0
         d OenShpType      s              1
         d OenType         s              1    inz('Q')
         d OenWeight       s              7  0
         d pseg            s              1
         d TheUnique       s             28
         d TheWeight       s             10  4
         d TimeStamp       s               z
         d ToThePenny      s              9  2
         d WidthDec        s              5  5
         d WorkCost        s              7  2
         d WorkSeq         s              4  0
         d WroteOne        s              1    inz('N')
          *
         d keydupcheck     s             62
         d DupCheck        s             62    dim(9999)
         d DC#             s              4  0
         d DC##            s              4  0
          *
          * Data structures
          *
         d                 ds
         d DsWidth                 1      7  4 inz
         d  DsWInch                1      3
         d  DsWFract               4      7
    
         d                 ds
         d DsLength                1      9  4 inz
         d  DsLFeet                1      2
         d  DsLInch                3      5
         d  DsLInchDec             3      5  0
         d  DsLFract               6      9
          *
         d                 ds
         d WholeNumber             1      4  0 inz
         d  Numerator              1      2  0
         d  Denominator            3      4  0
          *
          * Procedure calls
          *
         d Command         pr                  EXTPGM('QCMDEXC')
         d  CmdString                   256
         d  CmdLength                    15  5
          *
         d GetWeight       pr                  EXTPGM('OENAH')
         d  OenType                       1
         d  OenWeight                     7  0
         d  OenInd                        1
         d  OenCustomer                   5  0
         d  OenShipto                     5  0
         d  OenShpType                    1
         d  OenFrcCity                   16
         d  OenFrcState                   2
         d  OenRate                       7  2
         d  OenLotRate                    7  2
          *
          /copy qprcsrc,CSTMKUP_CP
          *
    
          /free
    
                read  HGQPGRP;
                dow   not%eof(HGQPGRP);
    
                 // chain out to the release file to see if there are current releases
    
                     chain (QPGACT:QPGPRT) HGCIREL;
                  if QPGAFL = 'Y'  or
                     %found(HGCIREL) and QPGCFL = 'Y' ;
    
                  //if QPGPRT = '1325546';
                     exsr  $CibCustom;
    
                       if lastpartname = *blanks;
                        lastpartname = QPGPRT;
                       endif;
    
                       if    lastpartname <> QPGPRT;
                        clear dupcheck;
                        clear DC#;
                        lastpartname = QPGPRT;
                       endif;
    
                  //endif;
                  endif;
    
                reset WroteOne;
                read  HGQPGRP;
                enddo;
    
                if %open(CIBCUSTOM);
                close CIBCUSTOM;
                open CIBCUSTOM;
                endif;
    
                exsr  $FixThePenny;
                exsr  $Release;
             *inlr = *on;
    
            //=========================================
            //  $CibCustom - Populate Cibcustom
            //=========================================
    
            begsr $CibCustom;
    
    
    
                    clear  CIBCUSTOMR;
    
                    CBCURRENT = 'Y';
                    CBACTIVE  = 'Y';
                    CBVERSION = 1;
                    CBCOMP    = 20;
                    CBSL#     = QPGACT;
                    CBPART    = QPGPRT;
                    NextPart# += 1;
                    CBPARTID  = NextPart#;
                    CBPARTD   = QPGDSC;
                    CBSPECN   = QPGSPE;
                    CBECHG1   = QPGEC1;
                    CBECHG2   = QPGEC2;
                    CBPRTREQ  = QPGPFL;
                    CBBUNT    = 'CWT';
    
             //
             // before the write loop thru the materials file to get  bracket qtys
             //
    
                       exsr  $CrtUnique;
    
                      setll (QPGACT:QPGPRT:QPGGRP) HGQPMATL;
                      reade (QPGACT:QPGPRT:QPGGRP) HGQPMATL;
                      dow not%eof(HGQPMATL);
    
                     if  QPGDM2 = *zeros and QPGDM1 <> *zeros and
                         QPG1OD = *blanks;
                         QPGDM2 = QPGDM1;
                         QPGDM1 = *zeros;
                     endif;
    
                     Dswidth  = QPGDM1;
                     Dslength = QPGDM2;
    
    
               //first look thru the work file
    
    
                    setll (QPGPRD) XREFPROD;
                    reade (QPGPRD) XREFPROD;
                      dow  not%eof(XREFPROD);
    
                        if lsamat <> *blanks;
                        CBRMAT  = LSAMAT;
                        CBRANAL = LSAANAL;
                        CBRSIZE = LSSIZE;
                        endif;
    
                      reade (QPGPRD) XREFPROD;
                      enddo;
    
    
    
    
                if CBRMAT = *blanks;
                    setll (QPGPRD) INMINVTX;
                    reade (QPGPRD) INMINVTX;
                      dow  not%eof(INMINVTX);
                        CBRMAT  = IMMAT;
                        CBRANAL = IMANAL;
                        CBRSIZE = IMSIZE;
    
                        if  IMLIN <> *blanks;
                          if  %dec(IMLIN:3:0) >= QPMSD2;
                          leave;
                          endif;
                        endif;
    
                    reade (QPGPRD) INMINVTX;
                      enddo;
                endif;
    
                    chain (IMMAT) InDescA;
                      if %found(InDescA);
                         select;
    
                         when IdSection = 'PLT';
                         pseg = 'P';
    
                         when IdSection = 'SHT';
                         Pseg = 'S';
    
                         when IdSection = 'EM ';
                         Pseg = 'E';
    
                         when IdSection = 'GR ';
                         Pseg = 'G';
    
                         other;
                         Pseg = *blanks;
    
                         endsl;
    
                      endif;
    
    
                     CBFWDIN = %dec(DsWInch:3:0);
                     CBFWDFR = %dec(DsWFract:4:0);
    
                        if  pseg = *blanks;
                         CBFLDFT = %div(DsLInchDec:12);
                         CBFLDIN = %rem(DsLInchDec:12);
                         CBFLDFR = %dec(DsLFract:4:0);
                        else;
                         CBFLDFT = *zeros;
                         CBFLDIN = %dec(DsLInch:3:0);
                         CBFLDFR = %dec(DsLFract:4:0);
                        endif;
    
             // if QPGR1O = 'Y' and QPGR2I = *blanks then this is a circle
    
                          if  QPGR1o = 'Y' and QPGR2I = *blanks;
                           CBRCIRC = 'C';
                          endif;
    
                     CBRNUMFMT = 'D';
    
                       CBBWEIGHT = QPMWPP;
                       CBAWEIGHT = QPGWPP;
    
                       cbbrck#  = QPMPCS;
                       cbanluse = QPMEAU;
                       cbunqkey = TheUnique;
                       cbaddusr = @USER;
                       cbastamp = %timestamp();
    
                       Dswidth  = QPMSD1;
                       Dslength = QPMSD2;
                       cbyield  = QPMPPS;
                       cbbuyout = 'N';
    
                       cbnwdin = %dec(DsWInch:3:0);
                       cbnwdfr = %dec(DsWFract:4:0);
    
                        if  pseg = *blanks;
                         CBNLDFT = %div(DsLInchDec:12);
                         CBNLDIN = %rem(DsLInchDec:12);
                         CBNLDFR = %dec(DsLFract:4:0);
                        else;
                         CBNLDFT = *zeros;
                         CBNLDIN = %dec(DsLInch:3:0);
                         CBNLDFR = %dec(DsLFract:4:0);
                        endif;
    
                 //jamie
                     if  CBNLDIN = *zeros and CBNWDIN <> *zeros and
                         QPG1OD = *blanks or
                         CBNLDFR = *zeros and CBNWDFR <> *zeros and
                         QPG1OD = *blanks;
                         CBNLDIN =  cbnwdin;
                         CBNLDFR =  cbnwdfr;
                         clear  cbnwdin;
                         clear  cbnwdfr;
                     endif;
    
    
    
    
             //
             // If the cost is *zeros use replacement cost
             //
                      setll (CBRMAT:CBRANAL:CBRSIZE) OERRPCSA;
                      reade (CBRMAT:CBRANAL:CBRSIZE) OERRPCSA;
                             dow not%eof(OERRPCSA);
                                 WorkCost = (ORRC + ORRCE);
    
                      reade (CBRMAT:CBRANAL:CBRSIZE) OERRPCSA;
                             enddo;
    
                             if CBAWEIGHT > *zeros;
                             cbucost = (100/CBAWEIGHT * QPMCPP);
                             endif;
    
                             if CBUCOST = *zeros;
                              chain (20 : 20 : CBRMAT : CBRANAL : CBRSIZE) INMINVTB;
                             if  %found(INMINVTB);
                             CBUCOST = IMSCST;
                             endif;
                             endif;
    
    
                       write CIBCUSTOMR;
                       exsr  $Material;
                       exsr $CicAdlb;
                       exsr $Messages2;
    
                      reade (QPGACT:QPGPRT:QPGGRP) HGQPMATL;
                      enddo;
    
    
    
            endsr;
    
            //=========================================
            //  $CicAdlb - write out the labor
            //=========================================
    
            begsr $CicAdlb;
    
    
             //
             // Write labor by selected part.
             //
                      setll (QPMACT:QPMPRT:QPMGRP:QPMQSQ) HGQPPROC;
                      reade (QPMACT:QPMPRT:QPMGRP:QPMQSQ) HGQPPROC;
                      dow not%eof(HGQPPROC);
    
                      clear CICADLBR;
    
                         if (QPPSRT * 10) < 999;
                           CCDSPSEQ  = (QPPSRT * 10);
                         else;
                           CCDSPSEQ  = 999;
                         endif;
    
                      CCSETTIM  = QPPTST;
                      CCHOURCST = QPPWAG;
                      CCCOST    = %dech(QPPCPP:9:2);
                      CCUNITP   = %dech(QPPPPP:7:2);
    
                      chain (QPGACT:QPGPRT:QPGGRP:QPMQSQ:QPPPSQ) HGQPPARM;
                         if %found(HGQPPARM);
                         CCTORCH  = QPTC;
                         CCINTPR  = QPPC;
                         CCBRNIPP = QPBI;
                         endif;
    
                           if CCBRNIPP = *zero;
                            CCBRNIPP = QPBLST;
                           endif;
    
    
                        select;
    
                         when QPPPRC = 24200;
                         CCLABCOD = 'SX';
    
                         when QPPPRC = 55;
                         CCLABCOD = 'SC';
    
                         when QPPPRC = 19000;
                         CCLABCOD = 'MC';
    
                         when QPPPRC = 23;
                         CCLABCOD = 'BV';
    
                         when QPPPRC = 21100;
                         CCLABCOD = 'BV';
    
                         when QPPPRC = 24050;
                         CCLABCOD = 'CP';
    
    
                         when QPPPRC = 35;
                         CCLABCOD = 'DB';
    
                         when QPPPRC = 26600;
                         CCLABCOD = 'DR';
    
                         when QPPPRC = 21;
                         CCLABCOD = 'FF';
    
                         when QPPPRC = 16205;
                         CCLABCOD = 'MC';
    
                         when QPPPRC = 24962;
                         CCLABCOD = 'FI';
    
                         when QPPPRC = 24600;
                         CCLABCOD = 'LV';
    
                         when QPPPRC = 24961;
                         CCLABCOD = 'BD';
    
                         when QPPPRC = 14400;
                         CCLABCOD = 'SQ';
    
                         when QPPPRC = 14300;
                         CCLABCOD = 'SC';
    
                         when QPPPRC = 40;
                         CCLABCOD = 'LF';
    
                         when QPPPRC = 16200;
                         CCLABCOD = 'MC';
    
                         when QPPPRC = 14200;
                         CCLABCOD = 'SQ';
    
                         when QPPPRC = 14000;
                         CCLABCOD = 'SC';
    
                         when QPPPRC = 29;
                         CCLABCOD = 'NJ';
    
                         when QPPPRC = 24;
                         CCLABCOD = 'BV';
    
                         when QPPPRC = 21000;
                         CCLABCOD = 'BV';
    
                         when QPPPRC = 17000;
                           select;
                             when QPGLA = 152101;
                              CCLABCOD = 'PO';
                             when QPGLA = 152102;
                              CCLABCOD = 'WL';
                             when QPGLA = 152104;
                              CCLABCOD = 'LP';
                             when QPGLA = 152105;
                              CCLABCOD = 'MC';
                             when QPGLA = 152106;
                              CCLABCOD = 'SC';
                             when QPGLA = 152201;
                              CCLABCOD = 'GR';
                             when QPGLA = 152301;
                              CCLABCOD = 'DR';
                             when QPGLA = 152401;
                              CCLABCOD = 'PU';
                             when QPGLA = 152501;
                              CCLABCOD = 'FA';
                             when QPGLA = 152601;
                              CCLABCOD = 'HG';
                             when QPGLA = 152701;
                              CCLABCOD = 'PT';
                             when QPGLA = 152801;
                              CCLABCOD = 'LV';
                             when QPGLA = 152901;
                              CCLABCOD = 'FM';
                             when QPGLA = 152931;
                              CCLABCOD = 'ET';
                              other;
                              CCLABCOD = '??';
                           endsl;
    
                         when QPPPRC = 14;
    
                           if QPGPFL <> 'Y';
                             CCLABCOD = 'FC';
                           else;
                             CCLABCOD = 'FT';
                           endif;
    
                         when QPPPRC = 24955;
                         CCLABCOD = 'PK';
    
                         when QPPPRC = 24960;
                         CCLABCOD = 'PM';
    
                         when QPPPRC = 15;
                         CCLABCOD = 'FS';
    
                         when QPPPRC = 24000;
                         CCLABCOD = 'FW';
    
                         when QPPPRC = 24800;
                         CCLABCOD = 'ZZ';
    
                         when QPPPRC = 16000;
                         CCLABCOD = 'PS';
    
                         when QPPPRC = 20;
                         CCLABCOD = 'WL';
    
                         when QPPPRC = 26000;
                         CCLABCOD = 'WL';
    
                         when QPPPRC = 26100;
                         CCLABCOD = 'WR';
    
                         when QPPPRC = 24130;
                         CCLABCOD = 'KS';
    
                         when QPPPRC = 15000;
                         CCLABCOD = 'FL';
    
                         when QPPPRC = 26;
                         CCLABCOD = 'XS';
    
                         when QPPPRC = 30002;
                         CCLABCOD = 'RT';
    
                         when QPPPRC = 24100;
                         CCLABCOD = 'KA';
    
                         when QPPPRC = 36;
                         CCLABCOD = 'WD';
    
                         other;
                         CCLABCOD = '**';
    
                        endsl;
    
                      CCUNQKEY  = cbunqkey;
                      CCBRCK#   = cbbrck#;
                      CCVERSION = cbversion;
                      CCTOTLTM  = QPPTPP;
                      CCTOOLCST = QPPTTC;
                      CCFIXTCST = QPPTFC;
    
                       chain (CCLABCOD) OEQOPDSA;
    
                         if %found(OEQOPDSA);
                          CCPRCGRP = OQPRCGRP;
                         endif;
                         if ccunitp > *zeros and
                            ccunitp-cccost > *zeros;
                         CCMARGIN = %dech(((ccunitp-cccost)/ccunitp) * 100 :3:0);
                         endif;
    
                              if  QPPPRC   = 17000;
                                 CCBUYOFLG = 'Y';
                              else;
                                 CCBUYOFLG = 'N';
                              endif;
    
                           if CCBRNIPP = *zeros;
                             exsr  $BurnInches;
                           endif;
    
                      //get burn speed  and pierce times.  jamie
    
                            chain (QPGPRD) HGPROD;
    
                             if %found(HGPROD);
                              chain (QPPPRC:PRTHCK) HGBRNSPD;
    
                                if %found(HGBRNSPD);
                                 ccburnspd = bsipm;
                                 ccintprtm = bsipt;
                                 ccextprtm = bsept;
                                endif;
    
                             endif;
    
    
                            write CICADLBR;
    
                              if    CCUNITP = *zeros and CCCOST <> *zeros;
                               write nopricer;
                              endif;
    
                            xxunqkey  = CCUNQKEY;
                            xxBRCK#   = CCBRCK#;
                            xxVERSION = CCVERSION;
                            xxunitp   = %dec(QPMSUP:7:2)+ QPMPVPP;
                            write XREFR;
    
    
                 //Messages by process
    
                  setll (QPMACT:QPMPRT:QPMGRP:QPMQSQ:QPPPSQ) HGQPDMSG;
                  reade (QPMACT:QPMPRT:QPMGRP:QPMQSQ:QPPPSQ) HGQPDMSG;
    
                    dow not%eof(HGQPDMSG);
    
                      keydupcheck = %editc(QPDACT:'X') + QPDPRT + QPDMSG + CCLABCOD;
                      DC## = 1;
                      DC## =  %lookup(keydupcheck:dupcheck:DC##);
                      if DC## = *zeros;
                      DC# += 1;
                      dupcheck(DC#) = keydupcheck;
                      clear CIDSPECR;
    
                      CDCOMP    = 20;
                      CDVERSION = 1;
                      CDPART    = QPMPRT;
                      CDSL#     = QPMACT;
                      CDLABCOD  = CCLABCOD;
                      CDLABSEQ  = CCDSPSEQ;
                      CDCOMM    = QPDMSG;
                      CDCOMSEQ  = CCDSPSEQ;
                      CDUNQKEY  = CCUNQKEY;
    
                      write  CIDSPECR;
    
                      endif;
    
                      reade (QPMACT:QPMPRT:QPMGRP:QPMQSQ:QPPPSQ) HGQPDMSG;
                    enddo;
    
    
                            exsr  $Messages;
    
    
                      reade (QPMACT:QPMPRT:QPMGRP:QPMQSQ) HGQPPROC;
                      enddo;
    
            endsr;
    
    
            //=========================================
            //  $Releases - write out the releases
            //=========================================
    
            begsr $Release;
    
                setll *START HGCIREL;
                read HGCIREL;
                 dow not%eof(HGCIREL);
    
                   clear  CIHRELEASR;
    
                   CHACCT    =    CRACCT;
                   CHPART    =    CRPART;
                   CHVERSION =    1;
                   CHSHIPTO  =    CRSHIP;
                   CHDUEDAT  =    CREWDW;
                   CHSTRDAT  =
                   %uns(%char(%Date(CRFLWD:*ISO)+ %days(7):*ISO0));
    
                   CHEXPDAT  =    %uns(%char(%Date()+ %months(6) :*iso0));
                   CHPONM    =    CRPO;
                   CHPOLINE  =    CRPOLN;
                   CHFIRMFLG =    CRFFLG;
                   CHRELPCS  =    CRQTY;
    
             //
             //  Entered by
             //
    
                   CHENTDAT  =    %uns(%char(%Date():*ISO0));
                   CHENTTIM  =    %Uns( %Char( %Time( timeStamp ) : *HMS0 ) );
                   CHENTUSER =    @USER;
    
    
                   chain (20 :CHACCT :CHPART) CIBCUSTOMA;
                              if  %found(CIBCUSTOMA);
                               CHUNQKEY = ACBUNQKEY;
                              endif;
    
                   clear CHSHIPTO;
                    select;
    
                     when CRACCT = 635  and
                          CRSHIP = 1;
                     CHSHIPTO = 99999;
    
                     when CRACCT = 805  and
                          CRSHIP = 2;
                     CHSHIPTO = 99999;
    
                     when CRACCT = 1058 and
                          CRSHIP = 14;
                     CHSHIPTO = 99999;
                     other;
                     CHSHIPTO = CRSHIP;
                    endsl;
    
                   write  CIHRELEASR;
    
    
                 read HGCIREL;
                 enddo;
    
            endsr;
    
            //=========================================
            //  $Material - Write material/freight
            //=========================================
    
            begsr $Material;
    
                  for count = 1 to 3;
    
                      clear CICADLBR;
    
                      CCBRCK#   =  CBBRCK#;
                      CCVERSION = CBVERSION;
                      CCPRCGRP  = 500;
                      CCBUYOFLG = 'N';
    
                     select;
                       when count = 1;
                       CCDSPSEQ = 1;
                       CCLABCOD = 'Z1';
                       CCUNITP  = %dech(QPMPPP:7:2);
    
                        select;
                          when  CBBUNT = 'CWT';
                                CCCOST = CBBWEIGHT/100 *  CBUCOST;
    
                          when  CBBUNT = 'EA'or CBBUNT = 'EACH';
                                CCCOST = CBUCOST;
                        endsl;
    
                       when count = 2;
                         CCLABCOD = 'Z3';
                         CCCOST   = QPMPVPP;
                         CCUNITP  = QPMPVPP;
                         CCDSPSEQ =  2;
                       when count = 3;
                         CCLABCOD = 'Z2';
    
                         OenWeight   = (CBBWEIGHT * CBBRCK#);
                         OenInd      = 'I';
                         OenCustomer = CBSL#;
                         OenShipto   = *zeros;
                         OenShpType  = *blanks;
    
                         clear OenRate;
                         clear OenLotRate;
                         clear  Freight;
    
                         getweight(OenType : OenWeight : OenInd : OenCustomer :
                                   OenShipTo : OenShpType : OenFrcCity :
                                   OenFrcState : OenRate : OenLotRate);
    
    
    
                         Freight = %dec(OenRate);
                         CCCOST = Freight;
                           if QPGWPP > *zeros;
                            CCUNITP = %dech((QPMFPP/QPGWPP)*100:7:2);
                           endif;
                         CCDSPSEQ =  999;
                     endsl;
    
                     CCUNQKEY =  CBUNQKEY;
    
                    write CICADLBR;
                  endfor;
    
            endsr;
            //=========================================
            //  $CrtUnique - create unique ID
            //=========================================
    
            begsr $CrtUnique;
    
                   ISODate = %Date();
                   TimeStamp  = %Timestamp();
    
                   TheUnique = 'Cit' + %editc(@JOB#:'X') +
                                       %char(  %Subdt(ISODate:*Years))  +
                                       %char(  %Subdt(ISODate:*Months))  +
                                       %char(  %Subdt(ISODate:*Days))    +
                                       %char(  %Subdt(Timestamp:*Hours))   +
                                       %char(  %Subdt(TimeStamp:*Minutes)) +
                                       %char(  %Subdt(TimeStamp:*Seconds)) +
                                       %char(  %Subdt(TimeStamp:*MS));
            endsr;
    
            //=========================================
            //  $BurnInches
            //=========================================
    
            begsr $BurnInches;
    
                clear  WidthDec;
                  if CBFWDFR <> *zeros;
                    select;
                    when  CBRNUMFMT = 'D';
                    WidthDec  = CBFWDFR/10000;
                    when   CBRNUMFMT = 'M';
                    fourfour = CBFWDFR/10000;
                    WidthDec  = fourfour/25.4;
                    other;
                    WholeNumber = CBFWDFR;
    
                      if  Denominator <> *zeros;
                      WidthDec  =  %dech(Numerator/Denominator:5:5);
                      endif;
    
                    endsl;
                  endif;
    
                  clear  LengthDec;
                   if  CBFLDFR <> *zeros;
                      select;
                      when  CBRNUMFMT = 'D';
                      LengthDec  = CBFLDFR/10000;
                      when  CBRNUMFMT = 'M';
                      fourfour = CBFWDFR/10000;
                      LengthDec = fourfour/25.4;
                      other;
    
                      wholeNumber = CBFLDFR;
                        if Denominator <> *zeros;
                           LengthDec  =  %dech(Numerator/Denominator:5:5);
                        endif;
    
                      endsl;
                   endif;
    
                   BurnInches = %dech(((CBFWDIN + WidthDec) +
                                ((CBFLDFT/12) + CBFLDIN + LengthDec))*2:5:1);
                   CCBRNIPP = BurnInches;
    
              // get burn speed
                   CCBURNSPD  = QPBRNT;
    
    
    
            endsr;
    
            //=========================================
            //  $Messages - if messages then write them
            //=========================================
    
            begsr $Messages;
    
              if  Wroteone = 'N';
                  reset workseq;
    
                  Setll (QPGACT:QPGPRT:QPPGRP:QPPQSQ:QPPPSQ) HGQPVMSG;
                  reade (QPGACT:QPGPRT:QPPGRP:QPPQSQ:QPPPSQ) HGQPVMSG;
    
                     dow not%eof(HGQPVMSG);
                       clear CIDSPECR;
                       cdversion = cbversion;
                       cdcomp    = cbcomp;
                       cdpart    = cbpart;
                       cdsl#     = cbsl#;
                       cdlabcod  = CCLABCOD;
                       cdlabseq  = CCDSPSEQ;
                       cdcomm    = QPVMSG;
                       workseq += 1;
                       cdcomseq = workseq;
                       cdunqkey = cbunqkey;
    
                       write CIDSPECR;
                       WroteOne = 'Y';
                       reade (QPGACT:QPGPRT:QPPGRP:QPPQSQ:QPPPSQ) HGQPVMSG;
                     enddo;
    
              endif;
            endsr;
    
    
    
            //=========================================
            //  $Messages2 - write part messages
            //               QPPPSQ = *zeros
            //=========================================
    
            begsr $Messages2;
    
                  Setll (QPGACT:QPGPRT:QPPGRP:0:0) HGQPDMSG;
                  reade (QPGACT:QPGPRT:QPPGRP:0:0) HGQPDMSG;
    
                     dow not%eof(HGQPDMSG);
    
                      keydupcheck = %editc(QPDACT:'X') + QPDPRT + QPDMSG + CCLABCOD;
                      DC## = 1;
                      DC## =  %lookup(keydupcheck:dupcheck:DC##);
                      if DC## = *zeros;
                      DC# += 1;
                      dupcheck(DC#) = keydupcheck;
    
                      clear CIDSPECR;
    
                      CDCOMP    = 20;
                      CDVERSION = 1;
                      CDPART    = QPPPRT;
                      CDSL#     = QPPACT;
                      CDLABCOD  = *Blanks;
                      CDLABSEQ  = 0;
                      CDCOMM    = QPDMSG;
                      CDCOMSEQ  = CCDSPSEQ;
                      CDUNQKEY  = CCUNQKEY;
    
                      write  CIDSPECR;
    
                      endif;
    
                      reade (QPGACT:QPGPRT:QPPGRP:0:0) HGQPDMSG;
                      enddo;
    
            endsr;
    
    
            //=========================================
            //  $FixThePenny - Fix the pennies
            //=========================================
    
            begsr $FixThePenny;
    
                read CIBCUSTOM;
                dow not%eof(CIBCUSTOM);
    
                clear  ToThePenny;
    
                setll (CBUNQKEY:CBVERSION:CBBRCK#) CICADLBD;
                reade(n) (CBUNQKEY:CBVERSION:CBBRCK#) CICADLBD;
    
                  dow not%eof(CICADLBD);
    
                      if D_CCLABCOD <> 'Z2';
                       ToThePenny += D_CCUNITP;
                      else;
                       TheWeight  = %dech((D_CCUNITP/100 * CBAWEIGHT):9:2);
                       ToThePenny += %dec(TheWeight:9:2);
                      endif;
    
                   reade(n) (CBUNQKEY:CBVERSION:CBBRCK#) CICADLBD;
                  enddo;
    
            // get the steve selling price
    
           chain (CBUNQKEY:CBVERSION:CBBRCK#) XREF$PRC;
           if %found(XREF$PRC);
    
    
           // i know read it again  for update
    
              if    ToThePenny <> XXUNITP;
                setll (CBUNQKEY:CBVERSION:CBBRCK#) CICADLBD;
                reade (CBUNQKEY:CBVERSION:CBBRCK#) CICADLBD;
    
                  dow not%eof(CICADLBD);
    
    
                    if D_CCLABCOD  = 'Z1';
    
                         select;
                           when ToThePenny > XXUNITP;
                           D_CCUNITP -= (ToThePenny  - XXUNITP);
                           Update D %Fields(D_CCUNITP);
    
    
                           when ToThePenny < XXUNITP;
                           D_CCUNITP += (XXUNITP -  ToThePenny) ;
                           Update D %Fields(D_CCUNITP);
    
                         endsl;
                    endif;
    
                   reade (CBUNQKEY:CBVERSION:CBBRCK#) CICADLBD;
                  enddo;
              endif;
           endif;
    
    
                read CIBCUSTOM;
                enddo;
            endsr;
    
            //=========================================
            //  *inzsr - One time run subroutine.
            //=========================================
    
            begsr *inzsr;
    
            cmdstring = 'ovrdbf file(INMINVTX) tofile(PLTEST/INMINVTX)';
            cmdlength = %len(%trim(cmdstring));
            command(cmdstring : cmdlength);
    
            cmdstring = 'clrpfm hsafil/cibcustom';
            cmdlength = %len(%trim(cmdstring));
            command(cmdstring : cmdlength);
    
            cmdstring = 'clrpfm hsafil/cicadlb';
            cmdlength = %len(%trim(cmdstring));
            command(cmdstring : cmdlength);
    
            cmdstring = 'clrpfm hsafil/cidspec';
            cmdlength = %len(%trim(cmdstring));
            command(cmdstring : cmdlength);
    
            cmdstring = 'clrpfm xref$prc';
            cmdlength = %len(%trim(cmdstring));
            command(cmdstring : cmdlength);
    
            cmdstring = 'clrpfm cihreleas';
            cmdlength = %len(%trim(cmdstring));
            command(cmdstring : cmdlength);
    
            cmdstring = 'clrpfm noprice';
            cmdlength = %len(%trim(cmdstring));
            command(cmdstring : cmdlength);
    
               if not%open(INMINVTX);
                  open INMINVTX ;
               endif;
    
               if not%open(CIBCUSTOM);
                  open CIBCUSTOM;
                  open CIBCUSTOMA;
               endif;
    
               if not%open(CICADLB);
                  open CICADLB ;
                  open CICADLBD;
               endif;
    
               if not%open(CIDSPEC);
                  open CIDSPEC ;
               endif;
    
               if not%open(xref$prc);
                  open xref$prc;
               endif;
    
               if not%open(cihreleas);
                  open cihreleas;
               endif;
    
               if not%open(noprice);
                  open noprice;
               endif;
    
            endsr;
    
          /end-free
    
    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


    • #3
      Re: QCMDEXC question

      Would this definition be dependant on the operating system release??

      Comment


      • #4
        Re: QCMDEXC question

        Im going to have to say no on that one. Are you creating a seperate module and trying to call it from another program or are you embedding it as I did?

        here is smaller version

        Code:
         *                                                         
        d CmdLength       s             15  5                      
        d CmdString       s            256                         
         *                                                         
         * Procedure calls                                         
         *                                                         
        d Command         pr                  EXTPGM('QCMDEXC')    
        d  CmdString                   256                         
        d  CmdLength                    15  5                      
         *                                                         
        c                   eval      *inlr = *on                  
           //=========================================             
           //  *inzsr - One time run subroutine.                   
           //=========================================             
                                                                   
         /free                                                     
           begsr *inzsr;
                                                   
           cmdstring = 'dlyjob 10';                                
           cmdlength = %len(%trim(cmdstring));                     
           command(cmdstring : cmdlength);     
                            
           endsr;                      
         /end-free
        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


        • #5
          Re: QCMDEXC question

          external

          Code:
                * Procedure calls
                *
               d RUNCOMMAND      PR                  extpgm('RUNCOMMAND')
               d   CmdString                   30
          
               d RUNCOMMAND      PI
               d   CmdString                   30
                *
               d Command         pr                  EXTPGM('QCMDEXC')
               d  CmdString                    30
               d  CmdLength                    15  5
                *
                * Definitions
                *
               d CmdLength       s             15  5
          
                *
               c                   eval      *inlr = *on
                  //=========================================
                  //  *inzsr - One time run subroutine.
                  //=========================================
          
                /free
                  begsr *inzsr;
                  cmdlength = %len(%trim(cmdstring));
                  command(cmdstring : cmdlength);
                  endsr;
                /end-free
          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


          • #6
            Re: QCMDEXC question

            I was missing the field definitions of CMDSTRING and CMDLENGTH. Once I put them into my program, it compiled.

            Thanks for your help.

            Comment

            Working...
            X