Writing From a Data Structure

This is a simple RPG program used to create an FTP script file to push data to a server. The program reads in a database file, which contains FTP commands. The program writes a source file member out, setting the value of the replacement variable (the scan for the ampersand) witht the name of the file to be transmitted. Note the use of the *OUTPUT function on the externally defined DDS. This allows the program to write the source file record directly from the data structure.

     H/TITLE ** BBT105RP Prepare BBT Script **
     H DEBUG(*YES)
     H OPTION(*SRCSTMT : *NODEBUGIO) DFTACTGRP(*NO) ACTGRP('QILE')
     H BNDDIR('SOFTCODE')
      ****************************************************************
      * PROGRAM NAME - BBT105RP                                      *
      *                                                              *
      * FUNCTION     - This program builds outbound script data for  *
      *                the factor BB&T.                              *
      *                                                              *
      ****************************************************************
     FBBTSCRPF  IF   E           K DISK
     FFTPSRCPF  O    F  112        DISK
     D PGMDS         ESDS                  EXTNAME(SWPSTSP)                      Pgm status map

     D FTPSRC        E DS                  EXTNAME(QFTPSRC:*OUTPUT)              Source file map
    
     D DateFmt         DS
     D  ThisDateISO                   8S 0
     D  ThisDateYMD                   6S 0 OVERLAY(DateFmt:3)
    
     d   x             S              3  0
     d   z             S              3  0
     d  unknownFile    S               n
     d  invoiceFile    S               n
     d  creditRequest  S               n
     d  type           S              4a   inz('RT01')

     d BBT105RP        Pr
     d FileName                      20

     d BBT105RP        PI
     d FileName                      20

      /free
          ThisDateISO = %dec(%date(): *ISO);
          SETLL type BBTSCRPF;
          DOU %eof(BBTSCRPF);
             READE type BBTSCRPF;
             IF not %eof(BBTSCRPF);
                srcseq = scrseq;
                srcdat = ThisDateYMD;
                z = %scan('&': scrtxt: 1);
                IF z = 0;
                   srcdta = scrtxt;
                ELSE;
                   srcdta = %subst(scrtxt:1:z-1) + ' ' + %trim(fileName);
                ENDIF;
                write FTPSRCPF FTPSRC;
             ENDIF;
          ENDDO;
          *INLR = *ON;
          RETURN;
      /end-free