Write Directly to IFS from RPG

This program demonstrates writing to an IFS file. It is bound to the QC2LE directory and borrows the C functions to create a stream file, set the code page, then write variable length records to the stream file.

       Ctl-Opt Option( *NoDebugIO : *SrcStmt ) DftActGrp( *No )
               ActGrp( 'EFS' ) PgmInfo( *PCML : *Module )
               BndDir( 'EFS001_BD':'QC2LE') Main(EFS050RP);

       /Copy QCopySrc,PgmStsDS
      /Copy QCopySrc,EFS001_pr
      /Copy QCopySrc,EFS004_pr
      /Copy QCopySrc,IFSAPI

       Dcl-PR access         int(10) extproc('access') ;
          pathptr1           pointer   value           ;
          mode1              int(10)   value           ;
       End-Pr ;

       Dcl-PR open          int(10)       EXTPROC('open') ;
          filename          pointer VALUE ;
          openflags         int(10) VALUE  ;
          mode              int(10) Value OPTIONS(*NOPASS);
          codepage          uns(10) VALUE OPTIONS(*NOPASS);
       End-Pr ;

       Dcl-PR write          int(10)        EXTPROC('write') ;
         filehandle          int(10)        VALUE  ;
         datatowrite         pointer        VALUE  ;
         nbytes              uns(10)        VALUE  ;
       End-Pr ;

       Dcl-PR close          int(10)  EXTPROC('close');
          filehandle         int(10)  VALUE ;
       End-Pr ;

       Dcl-Pr Exit     extproc('exit') ;
          rc           uns(3:0) value  ;
       End-Pr Exit                     ;

       dcl-ds ap2HEADER extname('EFSPAYPF'); // Payment header
       End-DS;
       dcl-ds ap2IPDATA extname('EFSPMTPF'); // Payment Detail
       End-DS;

       Dcl-DS Documents     ;
          dsDocID  varchar(12);
          dsDocNum varchar(12);
          dsDocDate   date    ;
          dsPayID  int(10);
          dsEl1    varchar(72);
          dsEl2    varchar(72);
          dsEl3    varchar(72);
          dsDue       date    ;
          dsValue   zoned(15:2);
       End-DS               ;


       Dcl-S apFileName      char(30) ;
       Dcl-S filePathOut     char(128);
       Dcl-S thisFileOut     char(158);
       Dcl-S apfileNumber    zoned(4:0) ;
       Dcl-S CompanyCode     zoned(6:0) ;
       Dcl-S AccountNumber   zoned(10:0);
       Dcl-S p               int(5)     ;
       Dcl-S i               int(5)     ;
       Dcl-S g               int(5)     ;
       Dcl-S cr              char(1) inz(x'0D');
       Dcl-S lf              char(1) inz(x'0A');
       Dcl-S fd              int(10)    ;
       Dcl-S Err             int(10)    ;
       Dcl-s AsciiCodePage   uns(10) INZ(819) ;
       Dcl-s FileDesc        int(10) ;
       Dcl-s bytesRead       int(10) ;
       Dcl-s bytesWrt        int(10) ;
       Dcl-s returnInd       ind     ;
       Dcl-s returnInt       int(10) ;
       Dcl-s fileName       char(255);
       Dcl-s fullName       char(255);
       Dcl-s msgData        char(9999) ;
       Dcl-s testMsg        char(32767);
       Dcl-s dataRead       char(9899) ;
       Dcl-s EOR            char(2) inz(X'0D25') ;
       Dcl-s null           char(1) inz(X'00') ;
       Dcl-s thisDate       date inz(*SYS) ;
       Dcl-s moreRecordsRemain ind  ;
       Dcl-s noMoreRecords     ind  ;
       Dcl-s netPay         zoned(11:2) ;
       Dcl-s payAmount      zoned(11:2) ;
       Dcl-s payAdjust      zoned(11:2) ;
       Dcl-s thisSign       char(1)     ;
       Dcl-s prevDoc        varChar(12) ;
       Dcl-s netNull        int(5)      ;
       Dcl-S sumReturned   zoned( 9:2)       ;
       Dcl-S payReturned   zoned( 9:2)       ;

       Dcl-Proc EFS050RP ;
         Dcl-PI EFS050RP             extPgm('EFS050RP')        ;
           dateIn            char(8) CONST options(*NOPASS)    ;
         END-PI;

       //*---------------------------------------------*//
       //* If a date was passed in use it -- on an
       //* date error, exit the program.
       //*---------------------------------------------*//

       Monitor                                ;
          If %parms = 1                       ;
             thisDate = %date(dateIn : *ISO0) ;
          EndIf                               ;
       On-Error                               ;
          exit(0)                             ;
       EndMon                                 ;

       prevDoc = *blanks ;
       companyCode   = getEFScompany() ;
       AccountNumber = getEFSaccount() ;
       APfileName    = getEFSfileName('D') ;
       filePathOut   = getAPoutboundPath() ;
       thisFileOut   = %trim(filePathOut) + %trim(apFileName) ;
       FullName = %trimR(thisFileOut) + Null ;

       //*---------------------------------------------*//
       //* If file exists, quit the program
       //*---------------------------------------------*//
       FileDesc = access(%addr(fullName): fileDesc)      ;
       IF fileDesc = 0                                      ;
          exit(0)                                           ;
       ENDIF                                                ;
       //*---------------------------------------------*//
       //* Create the file and set the code page
       //*---------------------------------------------*//
       FileDesc = open(%addr(FullName)
                : O_CREAT + O_WRONLY + O_TRUNC + O_CodePage
                : S_IRWXU + S_IROTH
                : AsciiCodePage) ;

       ReturnInt = close(FileDesc) ;
       //*---------------------------------------------*//
       //* Open the file as text for Read-Write
       //*---------------------------------------------*//

        FileDesc = open(%addR(FullName) : O_TEXTDATA + O_RDWR) ;

        returnInd = closeEFSpaymentCursor() ;
        returnInd = SetEFSpaymentCursor(thisDate);
        returnInd = openEFSpaymentCursor() ;

       DoU noMoreRecords ;

          MoreRecordsRemain =
             getNextEFSpaymentEntry(%addr(Documents):%size(Documents)) ;

          If moreRecordsRemain ;

             If dsDocNum <> prevDoc ;  // Write payment header
                prevDoc = dsDocNum  ;
                sumReturned = getDocumentTotal(
                                                dsDocID  :
                                                dsDocNum :
                                                dsEl1    :
                                                dsEl2    );
                netPay = sumReturned ;

                netPay = %abs(netPay);
                FPRTYP = 'P' ;         // Payment type code
                FPPYID = %trim(dsDocID) + %subst(dsDocNum:5:8) ;
                FPFNUM = getAP2fileNumber() ;
                FPOSID = getOutsourceID() ;
                FPCONO = companyCode   ;
                FPACNO = AccountNumber ;
                FPVEND = '3333333'    ;
                FPVSUB = *blank;
                FPFDTE = getAP2fileDate() ;
                FPNETP = %editC(netpay:'M');
                FPNU01 = *BLANKS;
                FPPYDT = %dec(dsDue:*USA);
                FPFILL = *BLANKS ;

                clear msgData ;
                msgData = AP2Header + EOR ;
                BytesWrt = write(FileDesc : %addr(msgData) :
                           %len(%trimR(msgData)));
             EndIf;

             payAmount = %abs(dsValue);
             dsValue = dsValue * -1 ;
             If dsValue < 0 ;
                thisSign = '-' ;
             Else ;
                thisSign = '+' ;
             EndIf ;

             FIRTYP = 'I' ; // Invoice payment
             FIPYID = %trim(dsDocID) + %subst(dsDocNum:5:8) ;
             FIIVNO = %trim(dsDocNum) ;
             FIIVDT = %dec(dsDocDate : *USA);
             FIGSGN = thisSign ;
             FIGPAY = %editW(payamount:'0        .  ');
             %subst(FIGPAY:1:1) = '0';
             FIASGN = thisSign ;
             FIAPAY = %editW(payAdjust:'0        .  ');
             %subst(FIAPAY:1:1) = '0';
             FINSGN = thisSign ;
             FINPAY = %editW(payAmount:'0        .  ');
             %subst(FINPAY:1:1) = '0';
             FIGLNO = %trim(dsEl1) + '.' + %trim(dsEl2) + '.' +
                      %trim(dsEl3) ;
             FIPNOT = %editC(dsPayID : 'X') ;
             FIFILL = *BLANKS ;

             clear msgData ;
             msgData = AP2IPdata + EOR  ;
             BytesWrt = write(FileDesc : %addr(msgData) :
                        %len(%trimR(msgData)));
          Else ;

             noMoreRecords = *on ;

          EndIf ;

       EndDo ;

       returnInd = closeEFSpaymentCursor() ;
       ReturnInt = close(FileDesc );
       *InLR = *On;
       Return;

       End-Proc EFS050RP ; 

Input is managed through a service program--information is exchanged via a pointer to a data structure.