×

Good News Everybody!

The new search engine is LIVE!

Please report any problems to david (at) midrange.com.




This message is in MIME format. Since your mail reader does not understand
this format, some or all of this message may not be legible.
--
 <<QPSUPRTF008678.txt>>
enclosed is a program i wrote. I used a prototyped call to  QUSRMBRD for
this purpose

> On Fri, 8 Feb 2002, Smith, Mike wrote:
> >
> > Does anyone have an example of using this api, they would be willing to
> > share?
> > I need to determine the number of records in a file.
> >
>
> Mike,
>
> QDBRTVFD is a very complicated API, so I may have just missed it in the
> documentation -- but, this API doesn't appear to return the number of
> records in the file!
>
> The QUSRMBRD API can be used to retrieve the number of records in a
> member.  (just like the RTVMBRD CL command) which may be what you're
> looking for -- depending on if you truly want the number of records in the
> whole file, or if you really just wanted to know how many records are in a
> member.
>
> If you use the QUSLMBR API to get a list of members, you could call
> QUSRMBRD in a loop and total them up to get the total number of records
> in a file....
>
> I've used all of these APIs for various reasons before, just let me know
> what exactly you're after...
>
> _______________________________________________
> This is the RPG programming on the AS400 / iSeries (RPG400-L) mailing list
> To post a message email: RPG400-L@midrange.com
> To subscribe, unsubscribe, or change list options,
> visit: http://lists.midrange.com/cgi-bin/listinfo/rpg400-l
> or email: RPG400-L-request@midrange.com
> Before posting, please take a moment to review the archives
> at http://archive.midrange.com/rpg400-l.
--
  5722WDS V5R1M0  010525                  SEU SOURCE LISTING                    
        02/08/02 13:49:03                 PAGE    1
  SOURCE FILE . . . . . . .  T01V3TIBSS/QRPGLESRC
  MEMBER  . . . . . . . . .  GNRCHKACC
  SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 
...+... 8 ...+... 9 ...+... 0
    100

    800       * AUTHOR/DATE.......... Dean Bathke  -- 09.19.2001
    900       * MEMBER TEXT.......... check number of TIPSUBS and TIPADD# 
records
   1000       * PROJECT..............
   1100       * PASSED PARAMETERS.... MAXACC   (maximum allowed access lines)
   1200       *                       USEDACC  (Used Access Lines)
   1300       *                       WARNACC  (Level at which the client is 
within 2% of Max allowed)
   1400       *                       WARNCODE (Action calling program should 
take)
   1500       *                                0 = no action ** 1 = Warning 
Message ** 2 = Error Message and
   1600       *                                                                 
           disable program
   1700       *
   1800       * CALLED BY............  xxxxxxxxxxxxxxxxxxxxx
   1900       * CALLED PROGRAMS...... *NONE
   2000       * SPECIAL CREATE PARMS.
   2100       *                             ***END***
   2200       * +-------------------------------------------------------------+ 
*
   2300       * ¦                          ***FILES***                        ¦ 
*
   2400       * +-------------------------------------------------------------+ 
*
   2500      FGNLVAL    IF   E           K DISK
   2600       * Field Values Master File by VVFLD
   2700       *
   2800       * 
+----------------------------------------------------------------+
   2900       * ¦                          ***DATA***                           
 ¦
   3000       * 
+----------------------------------------------------------------+
   3100
   3200       * 
+----------------------------------------------------------------+
   3300       * Required for Prototype QUSRMBRD Prototype
   3400      D ERRORDS         ds           116
   3500      D BYTPRV                  1      4B 0
   3600      D BYTAVA                  5      8B 0
   3700      D MSGID                   9     15
   3800      D RESRVD                 16     16
   3900      D MSGDTA                 17    116
   4000       * 
+----------------------------------------------------------------+
   4100       *
   4200      D P_File          S             10A
   4300      D P_Lib           S             10A
   4400      D MaxAcc          S              9  0
   4500      D UsedAcc         S              9  0
   4600      D WarnAcc         S              9  0
   4700      D WarnCode        S              1A
   4800
   4900      D TotRecs         S              9  0
   5000      D DltRecs         S              9  0
   5100      D #USEDACC        S              9  0
   5200      D @NOMAX          S              1A
   5300      D @FOUND          S              1A
  5722WDS V5R1M0  010525                  SEU SOURCE LISTING                    
        02/08/02 13:49:03                 PAGE    2
  SOURCE FILE . . . . . . .  T01V3TIBSS/QRPGLESRC
  MEMBER  . . . . . . . . .  GNRCHKACC
  SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 
...+... 8 ...+... 9 ...+... 0
   5400      D @DONE           S              1A
   5500      D @SNDMSG         S              1A
   5600      D Perr            S              1A
   5700      D @YES            C                   CONST('Y')
   5800      D @NO             C                   CONST('N')
   5900       *-----------------------------------------------
   6000
   6100      D MESS            S            132A
   6200       *-----------------------------------------------
   6300      D/COPY QCPYSRC,GNBDSPFD2
   6400       *
   6500       * 
+------------------------------------------------------------------+
   6600       * ¦                       *** MAIN ***                            
   ¦
   6700       * 
+------------------------------------------------------------------+
   6800       *
   6900      C                   If        @NOMAX = @NO or  @SNDMSG = @YES
   7000
   7100       *   Clear Return Data Structure
   7200      C                   Clear                   QUSM0200
   7300
   7400       *   Get record count for TIPSUBS and TIPADD#
   7500      C
   7600      C                   Eval      E_Lib  = '*LIBL'
   7700      C                   Eval      E_File = 'TIPSUBS'
   7800      C                   Exsr      $GetCount
   7900
   8000      C                   IF        Perr = @NO
   8100      C                   Eval      TotRecs  = QUSNBRCR  + TotRecs
   8200      C                   Eval      DltRecs  = QUSNBRDR  + DltRecs
   8300      C                   Clear                   QUSM0200
   8400      C                   Eval      E_File = 'TIPADD#'
   8500      C                   Exsr      $GetCount
   8600      C                   Eval      TotRecs  = QUSNBRCR  + TotRecs
   8700      C                   Eval      DltRecs  = QUSNBRDR  + DltRecs
   8800      C                   EXSR      $CalcDta
   8900      C                   ENDIF                                          
        Perr = @NO
   9000
   9100      C                   EndIf                                          
        @NOMAX = @YES
   9200
   9300       * If @SNDMSG = YES this program was called from a command, we 
will want to send a User
   9400       * Message stating what the access line count is and the MAx 
allowed access lines.
   9500      C                   IF        @SNDMSG = @YES and Perr = @NO
   9600
   9700      C                   EVAL      MESS = %TRIML(%EDITC(USEDACC:'4'))
   9800      C                   IF        MAXAcc = *zero
   9900      C                   EVAL      %SUBST(MESS:10) = %TRIM('*NOMAX')
  10000      C                   Else
  10100      C                   EVAL      %SUBST(MESS:10) = 
%TRIM(%EDITC(MaXACC:'4'))
  10200      C                   ENDIF
  10300      C                   CALL      'GNRMSGW'
  10400      C                   PARM      'GNM9913'     @MSGID            7
  10500      C                   PARM      ' '           @FKEY             3
  10600      C                   PARM                    mess
  5722WDS V5R1M0  010525                  SEU SOURCE LISTING                    
        02/08/02 13:49:03                 PAGE    3
  SOURCE FILE . . . . . . .  T01V3TIBSS/QRPGLESRC
  MEMBER  . . . . . . . . .  GNRCHKACC
  SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 
...+... 8 ...+... 9 ...+... 0
  10700
  10800      C                   EndIF
  10900
  11000      C                   EVAL      *INLR = *ON
  11100      C                   Return
  11200       *
  11300      CSR   $GetCount     Begsr
  11400       * 
+------------------------------------------------------------------+
  11500       * ¦ *** Prototyped Call to qusrmbrd                               
   ¦
  11600       * 
+------------------------------------------------------------------+
  11700       * Get member additional information
  11800      C                   callp     qusrmbrdp(QUSM0200                :
  11900      C                                       253                     :
  12000      C                                       'MBRD0200'              :
  12100      C                                       ObjLibname              :
  12200      C                                       MbrName                 :
  12300      C                                       '0'                     :
  12400      C                                       errords                 )
  12500       *
  12600       *   Check for Errors
  12700      C                   If        BYTAVA  > 0
  12800      C                   Eval      PERR = @YES
  12900      C                   Else
  13000      C                   Eval      PERR = @NO
  13100      C                   EndIf
  13200      CSR                 EndSR
  13300       * 
+------------------------------------------------------------------+
  13400       * ¦ *** $CalcDta  - format data for return to calling program     
   ¦
  13500       * 
+------------------------------------------------------------------+
  13600      CSR   $CalcDta      Begsr
  13700      C                   If        Perr = @NO
  13800      C                   Eval      UsedAcc = TotRecs - Dltrecs
  13900
  14000      C                   Select
  14100
  14200      C                   When      UsedAcc > MaxAcc
  14300      C* Client exceeds Max allowed Acces Lines
  14400      C                   Eval      WarnCode = '2'
  14500
  14600      C                   When      UsedAcc >= WarnAcc
  14700      C* Client is within 2% of Max allowed Access Lines (Send Warning 
Message)
  14800      C                   Eval      WarnCode = '1'
  14900      C
  15000      C
  15100
  15200      C                   When      UsedAcc < WarnAcc
  15300      C* No action
  15400      C                   Eval      WarnCode = '0'
  15500      C
  15600      C                   EndSL
  15700      C
  15800      C
  15900      C
  5722WDS V5R1M0  010525                  SEU SOURCE LISTING                    
        02/08/02 13:49:03                 PAGE    4
  SOURCE FILE . . . . . . .  T01V3TIBSS/QRPGLESRC
  MEMBER  . . . . . . . . .  GNRCHKACC
  SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 
...+... 8 ...+... 9 ...+... 0
  16000      C
  16100      C
  16200      C                   EndIF
  16300      CSR                 Endsr
  16400       * 
+------------------------------------------------------------------+
  16500       * ¦ *** PSSR                                                      
   ¦
  16600       * 
+------------------------------------------------------------------+
  16700      CSR   *PSSR         Begsr
  16800      C                   EVAL      *INLR = *ON
  16900      C                   Return
  17000      CSR                 Endsr
  17100       *
  17200       * 
+------------------------------------------------------------------+
  17300       * ¦ *** INZSR *** Initialization                                  
   ¦
  17400       * 
+------------------------------------------------------------------+
  17500      CSR   *INZSR        begsr
  17600      C     *Entry        plist
  17700      C                   PARM                    MAXACC                 
        (9.0)
  17800      C                   PARM                    USEDACC                
        (9.0)
  17900      C                   PARM                    WARNACC                
        (9.0)
  18000      C                   PARM                    WARNCODE               
        (1A)
  18100      C                   PARM                    Perr                   
        (1A)
  18200
  18300      C                   Eval      TotRecs  = *Zero
  18400      C                   Eval      DltRecs  = *Zero
  18500      C                   IF        Perr <>  ' '
  18600      C                   Eval      @SNDMSG = @YES
  18700      C                   ELSE
  18800      C                   Eval      @SNDMSG = @NO
  18900      C                   ENDIF
  19000
  19100       * get the # of Access lines the client is licensed for (*ZERO = 
NOMAX)
  19200      C     'MAXACC'      CHAIN     GNLVAL                             50
  19300      C     '01':'YN'     XLATE     *IN50         @FOUND
  19400      C                   IF        @FOUND = @YES
  19500      C                   EVAL      MAXACC = VVVALU
  19600      C                   ENDIF
  19700
  19800      C                   IF        MAXACC = *ZERO
  19900      C                   Eval      @NOMAX = @YES
  20000      C                   Eval      WarnCode = '0'
  20100      C                   Eval      WarnAcc = *HIVAL
  20200      C                   Else
  20300       * Calculate Warning Level as 98% of MAXACC
  20400      C                   Eval      WarnAcc = MaxAcc -(MaxAcc * .02)
  20500      C                   Eval      @NOMAX = @NO
  20600      C                   EndIF
  20700      C
  20800      CSR                 ENDSR
                                  * * * *  E N D  O F  S O U R C E  * * * *


As an Amazon Associate we earn from qualifying purchases.

This thread ...


Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

This mailing list archive is Copyright 1997-2026 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].

Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.