PGM        PARM(&FILE &YN)                                         
             DCLF       FILE(QADSPDBR)                                          
             DCL        VAR(&FILE) TYPE(*CHAR) LEN(10)                          
             DCL        VAR(&LIBRET) TYPE(*CHAR) LEN(10)                        
             DCL        VAR(&ATR ) TYPE(*CHAR) LEN(10)                          
             DCL        VAR(&TXT ) TYPE(*CHAR) LEN(50)                          
             DCL        VAR(&YN) TYPE(*CHAR) LEN(1)                             
                                                                                
             DLTF       FILE(QTEMP/RELATE)                                      
             MONMSG CPF2105                                                     
   /* CPF2105     Object &1 in &2 type *&3 not found. */                        
   /*             Ignore - we don't care if the file exists now.  */            
                                                                                
             CHKOBJ     OBJ(*LIBL/&FILE) OBJTYPE(*FILE)                         
             MONMSG     MSGID(CPF9801) EXEC(GOTO CMDLBL(ERROR))                 
   /* CPF9801     Object &2 in library &3 not found. */                         
   /*             Whoops - we don't have a file to perform work on */           
   /*             this is bad - end immediately!                   */           
                                                                                
             DSPFFD     FILE(*LIBL/&FILE) OUTPUT(*OUTFILE) +                    
                          OUTFILE(QTEMP/$$TEMP) OUTMBR(*FIRST *REPLACE)         
             OVRDBF     FILE(QADSPFFD) TOFILE(QTEMP/$$TEMP) +                   
                          MBR(*FIRST)                                           
   /*  Sorry Kids – I didn’t supply an example of programs that use */
   /*  DSPFFD to create programs – but I can!  E-mail me and I’ll   */
   /*  Publish an example of this NEXT month! */
                                                                                
             RTVOBJD    OBJ(*LIBL/QPGMSRC) OBJTYPE(*FILE) +                     
                          RTNLIB(&LIBRET)                                       
             MONMSG     MSGID(CPF9801) EXEC(CHGVAR VAR(&LIBRET) +               
                          VALUE('QTEMP'))                                       
   /* CPF9801     Object &2 in library &3 not found. */                         
   /*             Find the Source PF for code creation - QPGMSRC */             
   /*             If not found, create in QTEMP.  For Packrats.  */             
                                                                                
             OVRDBF     FILE(OUTFIL) TOFILE(&LIBRET/QPGMSRC) MBR(&FILE)         
             CHKOBJ     OBJ(&LIBRET/QPGMSRC) OBJTYPE(*FILE) MBR(&FILE)          
             MONMSG     MSGID(CPF9801)                                          
                                                                                
             CRTSRCPF   FILE(&LIBRET/QPGMSRC) RCDLEN(240)                       
             MONMSG     MSGID(CPF0000)                                          
             RTVOBJD    OBJ(*LIBL/&FILE) OBJTYPE(*FILE) OBJATR(&ATR) +          
                          TEXT(&TXT)                                            
             ADDPFM     FILE(&LIBRET/QPGMSRC) MBR(&FILE) TEXT(&TXT)             
             MONMSG     MSGID(CPF7306) EXEC(CLRPFM +                            
                          FILE(&LIBRET/QPGMSRC) MBR(&FILE))                     
   /* CPF7306     Member &1 not added to file &2 in &3.  */              

   /* FFD Program Creation Tools go here!!  */

       
             DSPDBR     FILE(&FILE) OUTPUT(*OUTFILE) +                          
                          OUTFILE(QTEMP/RELATE) OUTMBR(*FIRST *REPLACE)         
             MONMSG     MSGID(CPF0000) EXEC(GOTO CMDLBL(END_OF_JOB))            

             OVRDBF     FILE(QADSPDBR) TOFILE(QTEMP/RELATE) MBR(*FIRST)         
             OVRDBF     FILE(QAFDACCP) TOFILE(QTEMP/RELATE2) +                  
                          MBR(*FIRST)                                           
             DSPFD      FILE(*LIBL/&FILE) TYPE(*ACCPTH) +                       
                          OUTPUT(*OUTFILE) OUTFILE(QTEMP/RELATE2) +             
                          OUTMBR(*FIRST *REPLACE)                               
             MONMSG     MSGID(CPF0000) EXEC(GOTO CMDLBL(AGAIN))                 
             CALL CR8CSP3 ('000800')                                            
AGAIN:                                                                          
             RCVF                                                               
             MONMSG     MSGID(CPF0000) EXEC(GOTO CMDLBL(END_OF_JOB))            
             DSPFD      FILE(&WHRELI/&WHREFI) TYPE(*ACCPTH) +                   
                          OUTPUT(*OUTFILE) OUTFILE(QTEMP/RELATE2) +             
                          OUTMBR(*FIRST *REPLACE)                               
             MONMSG     MSGID(CPF0000) EXEC(GOTO CMDLBL(END_OF_JOB))            
             CALL CR8CSP3 ('0008500')                                           
             GOTO AGAIN                                                         
                                                                                
                                                                                
             GOTO       CMDLBL(END_OF_JOB)                                      
                                                                                
ERROR:       RCLRSC                                                             
             SNDPGMMSG  MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA('File +             
                          not found in library list') MSGTYPE(*ESCAPE)          
 END_OF_JOB:                                                                    
             DLTF       FILE(QTEMP/RELATE)                                      
             MONMSG CPF0000                                                     
             DLTF       FILE(QTEMP/RELATE2)                                     
             MONMSG CPF0000                                                     
             DLTOVR     FILE(*ALL)                                              
             MONMSG     MSGID(CPF0000)                                          
             RCLRSC                                                             
             ENDPGM                                                             


 