آر بي جي (لغة برمجة)
مثال للشفرة

البرنامج التالي يستقبل رقم العميل كمعيار للمدخلات ويقوم بإرجاع الاسم والعنوان كمعيار للنواتج.
* على مر التاريخ فإن آر بي جي كانت لغة عمودية بطبيعتها، برغم أنها ذات نسق وصياغات حرة
 * مسموح بها تحت ظروف معينة.
 * الغرض من تعدد الشفرة في السطور يحدده
 * شفرة حرفية في العمود رقم 6.
 * ورمز النجمة (*) في العمود السابع يشير إلى سطر تعليقي

 * مواصفات "F" (ملف) تحدد الملفات وأجهزة i/o الأخرى
 F ARMstF1 IF E K Disk Rename(ARMST:RARMST)

 * مواصفات "D" تستخدم في تحديد المتغيرات
 D pCusNo  S  6p 0
 D pName  S  30a
 D pAddr1  S  30a
 D pAddr2  S  30a
 D pCity  S   25a
  D pState   S    2a
  D pZip   S    10a

  * مواصفات "c" (الحساب) تستخدم للعبارات القابلة للتنفيذ
  * يتم تحديد المعايير باستخدام plist وparm opcodes
  C  *entry  plist
  C      parm          pCusNo
   C          parm          pName
   C          parm                 pAddr1
     C                   parm                    pAddr2
     C                   parm                    pCity
     C                   parm                    pState
     C                   parm                    pZip

      * أما أمر "chain" فيستخدم من أجل الوصول العشوائي إلى ملف ذو شفرة
     C     pCusNo        chain     ARMstF1

      * وإذا ما استدل على وجود تدوين ما، انقل الحقول من الملف إلى معايير
     C                   if        %found
     C                   eval      pName  = ARNm01
     C                   eval      pAddr1 = ARAd01
     C                   eval      pAddr2 = ARAd02
     C                   eval      pCity  = ARCy01
     C                   eval      pState = ARSt01
     C                   eval      pZip   = ARZp15
     C                   endif

      * تستعين لغة آر بي جي بالتحولات "switches". تحول واحد "LR" عادة يرمز إلى "آخر تدوين last record"
      * LR في الواقع تحدد البرنامج ومساحة بياناته بحيث تكون قابلة للإزالة من الذاكرة.
     C                   eval      *InLR = *On
يستعين نفس البرنامج بحسابات حرة:
* مواصفات "F" (الملف) تحدد الملفات وأدوات i/o الأخرى
     FARMstF1   IF   E        K     Disk    Rename(ARMST:RARMST)

      * مواصفات "D" تستخدم في تحديد المتغيرات والمعايير
      * "النموذج الأصلي prototype" للبرنامج موجود بملف مستقل
      * بحيث يسمح للبرامج الأخرى باستدعائه
      /copy cust_pr
      * يصف "السطح البيني للإجراء" معايير المُدخل
     D getCustInf      PI
     D  pCusNo                        6p 0   const
     D  pName                        30a
     D  pAddr1                       30a
     D  pAddr2                       30a
     D  pCity                        25a
     D  pState                        2a
     D  pZip                         10a
      /free
        // أمر "chain" يستخدم من أجل الوصول العشوائي للملفات المُشفرة
        chain pCusNo ARMstF1;

        // إذا ما استدل على وجود تدوين، انقل الملفات إلى معايير
        if %found;
           pName  = ARNm01;
           pAddr1 = ARAd01;
           pAddr2 = ARAd02;
           pCity  = ARCy01;
           pState = ARSt01;
           pZip   = ARZp15;
        endif;

      // تستعين لغة آر بي جي بالتحولات "switches". تحول واحد "LR" عادة يرمز إلى "آخر تدوين last record"
      // LR في الواقع تحدد البرنامج ومساحة بياناته بحيث تكون قابلة للإزالة من الذاكرة.
        *InLR = *On;
      /end-free
يستعين نفس البرنامج بحسابات حرة: وSQL مدرج
* لا تحتاج لغة آر بي جي فور مرة أخرى الاستعانة بمؤشر *INLR لإنهاء البرنامج.
      *باستخدام الكلمة الرئيسية الأساسية في العنوان "H"، وتحديد "main"
      * أو اسم إجراء المُدخل، سيبدأ البرنامج وينتهي بشكل معتاد باستخدام
      * دورة آر بي جي القديمة منذ عقود وبالتالي سيبدأ البرنامج بشكل أشبه كثيرا بالسي وينتهي منطقيا.
     H  MAIN('GETCUSTINF')
      * مواصفات "D" تستخدم في تحديد المتغيرات والمعايير
      * "النموذج الأصلي prototype" للبرنامج موجود بملف مستقل
      * بحيث يسمح للبرامج الأخرى باستدعائه
      /copy cust_pr
      * يصف "السطح البيني للإجراء" معايير المُدخل
     D getCustInf      PI
     D  pCusNo                        6p 0   const
     D  pName                        30a
     D  pAddr1                       30a
     D  pAddr2                       30a
     D  pCity                        25a
     D  pState                        2a
     D  pZip                         10a
      /free
        exec sql select ARNm01, ARAd01, ARAd02, ARCy01, ARSt01, ARZp15
                 into  :pName, :pAddr1, :pAddr2, :pCity, :pState, :pZip
                 from   ARMstF1
                 where  ARNo01 = :pCusNo
                 for fetch only
                 fetch first 1 row only
                 optimize for 1 row
                 with CS;
      /end-free
يصف «السطح البيني للإجراء» معايير المُدخل *
D getCustInf      PI
D  pCusNo                        6p 0   const
D  pName                        30a
D  pAddr1                       30a
D  pAddr2                       30a
D  pCity                        25a
D  pState                        2a
D  pZip                         10a
/free
exec sql select ARNm01, ARAd01, ARAd02, ARCy01, ARSt01, ARZp15
into  :pName, :pAddr1, :pAddr2, :pCity, :pState, :pZip
from   ARMstF1
where  ARNo01 = :pCusNo
for fetch only
fetch first 1 row only
optimize for 1 row
with CS;
/end-free
لنفترض أن نموذج الجدول ARMSTF1 صنع باستخدام عبارة SQL التالية:
create table armstf1 (arcnum decimal(7,0),
 arname char(30),
 aradd1 char(30),
 aradd2 char(30),
 arcity char(25),
 arstte char(2),
 arzip  char(10))
وبالنسبة لنظام تشغيل V7R1، فإن البرنامج السابق يمكن كتابته (بشكل صحيح وكامل) كالآتي:
H main(GetCustInf)
     D ARMSTF1       E DS
     P GetCustInf      B
     D GetCustInf      PI                  extpgm('CUS001')
     D  inCusNo                            like(arCNum) const
     D  outName                            like(arName)
     D  outAddr1                           like(arAdd1)
     D  outAddr2                           like(arAdd2)
     D  outCity                            like(arCity)
     D  outState                           like(arStte)
     D  outZip                             like(arZip)
      /free
       exec sql select arName, arAdd1, arAdd2, arCity, arStte, arZip
                into  :outName, :outAddr1, :outAddr2, :outCity, :outState,
                      :outZip
                from   ARMSTF1
                where  arCNum = :inCusNo
                fetch first 1 row only
                with CS
                use currently committed;
      /end-free
     P GetCustInf      E