*===============================================================
      *
      * To compile:
      *
      *      CRTBNDRPG  PGM(XXX/ORGLIST) SRCFILE(XXX/QRPGLESRC)
      *
      *===============================================================

     H DftActGrp(*NO) ActGrp(*CALLER)

     FOrgListDF cf   e             workstn
     F                                     sfile(sfl1:rrn1)
     F                                     infds(info)

     FEmpMst    if   e           k disk
     FEmpSub    if   e           k disk

      * Information data structure to hold attention indicator (AID) byte.
      * AID byte contains a code identifying the function
      * key used to return control to the program from the display file.
      * For more information see the DATA MANAGEMENT GUIDE.

     Dinfo             ds
     D cfkey                 369    369

      * Constants to compare to AID - F3, F12, F6, and ENTER keys.
      * Other values documented in DATA MANAGEMENT GUIDE.

     Dexit             C                   const(X'33')
     Dcancel           C                   const(X'3C')
     Dadd              C                   const(X'36')
     Denter            C                   const(X'F1')

      * Input parameter: Employee number

     D In_Employee     DS             7
     D   P_Employee                   7s 0

      * Prototype for NextLevel procedure: Receives two parameters
     D NextLevel       pr
     D   level                        3  0 value
     D   employee                     7s 0 value

      * Input parameter list - receives an employee number to start display

     C     *Entry        PList
     C                   Parm                    In_Employee

      * Get master record for input employee

     C     P_Employee    Chain     EmpMst
     C                   If        not %found
     C                   Eval      name = *blanks
     C                   Eval      name = 'Employee not found.'
     C                   Eval      *In32 = *on

      * If found, Trim blanks and form First /Last name field
     C                   Else
     C                   Eval      name = (%trimr(dbfnam) + ' ' +
     C                                     %trimr(dblnam))

      * Clear the subfile, then call the recursive NextLevel procedure
     C                   ExSr      clrsfl
     C                   CallP     NextLevel (1 : P_Employee)
     C                   Eval      *In90 = *on
     C                   If        rrn1 = 0
     C                   Eval      *in32 = *on
     C                   EndIf
     C                   EndIf

      * Simply redisplay subfile until user hits Exit or Cancel

     C                   DoU       (cfkey = exit) or (cfkey = cancel)
     C                   Write     fkey1
     C                   ExFmt     sf1ctl
     C                   EndDo

      * Close files and terminate.

     C                   Eval      *inlr = *on

      *********************************************************************
     C     ClrSfl        BegSr

      * Clear the subfile by activating SFLCLR and writing the subfile control
      * format.  Reset the subfile relative record number.

     C                   Eval      *in31 = *on
     C                   Eval      rrn1 = 0
     C                   Write     sf1ctl
     C                   Eval      *in31 = *off
      *
     C                   EndSr

      *********************************************************************
      * Recursive NextLevel subprocedure.  Drills down through the subordinate
      * tree, populating the subfile as it goes.

      * Begin subprocedure NextLevel

     P NextLevel       B
      *
      * Procedure interface.  Describes procedure parameters.
      * VALUE keyword causes paramters to be passed by value, not reference.
     D                 PI
     D   level                        3  0 value
     D   employee                     7s 0 value

      * Local variables - visible only within this subprocedure.

     D SaveSubord      s                   like(employ)

      * Key list for SFL002PF

     C     EmpSubKey     KList
     C                   KFld                    employee
     C                   KFld                    SaveSubord

      * Position to first subordinate record for this employee and read it.

     C     employee      SetLL     EmpSub
     C     employee      ReadE     EmpSub

      * Loop until EOF is encountered.

     C                   DoW       not %eof

      * Look up master record for the current subordinate.

     C     Subord        Chain     EmpMst
     C                   If        not %found
     C                   Eval      subnam = *blanks
     C                   Eval      subnam = 'Employee information not found'
     C                   Else

      *  fill the subnam subfile field with '...................'
      *  Use %TRIM BIF to strip leading and trailing spaces from database fields.
      *  Assign INTO the subnam field through the %subst function, indenting based
      *  upon the current level.

     C                   Eval      subnam = *all'.'
     C                   Eval      %subst(subnam : 2*(Level+1))=%trim(dbfnam) +
     C                                   ' ' + %trim(dblnam)

      * Update the global RRN counter, and write the new subfile record.

     C                   Eval      rrn1 = rrn1 + 1
     C                   Write     sfl1
     C                   EndIf

      * Save the subordinate in the local variable, and recursively
      * call NextLevel, updating the level number, and passing the
      * current subordinate as the input employee.

     C                   Eval      SaveSubord = Subord
     C                   CallP     NextLevel (Level + 1 : Subord)

      * Get next subordinate for the current employee.

     C     EmpSubKey     SetGT     EmpSub
     C     employee      ReadE     EmpSub
     C                   EndDo

      * End the procedure

     P                 E