RPGLE - Write directly to IFS
H dftactgrp( *no ) bnddir( 'QC2LE' ) OPTION(*SRCSTMT : *NODEBUGIO)
H*============================================================
H*
H*============================================================
FRUAF015D IF E DISK
FSRBNAM IF E K DISK
FSRBNFP IF E K DISK
FSRBNOI IF E K DISK
D*
D RC S 10I 0
D FileNam S 20A INZ('/code400/File819.txt')
D FileNamP S * INZ(%ADDR(FileNam))
D FileDescr S 10I 0
D O_CREAT S 10I 0 INZ(8)
D O_RDWR S 10I 0 INZ(4)
D O_TEXTDATA S 10I 0 INZ(16777216)
D O_CODEPAGE S 10I 0 INZ(8388608)
D Oflag S 10I 0 INZ(0)
D Omode S 10U 0 INZ(511)
D cp S 10U 0 INZ(819)
D WorkEmail S 50
D CmdString S 512
D CmdLength S 15 5
D SendEmail S 50
D Len S 03 0
D*
D Big S 500
D Customer S 11
D Key#2 S 10 Inz('*PHONE')
D Chr7 S 07
D Dec7 S 07 0
D Chr8 S 08
D Chr4 S 04
D Chr6 S 06
D Negative S 01
D Chr2 S 02
D Month S 02 0
D ChrMonth S 02
D Year S 04 0
D Day S 02 0
D ChrDay S 02
D ISODate S D
D Str S 03 0
D Q C CONST('''')
D*
D* Program Info
D*
D SDS
D @PGM 001 010
D @PARMS 037 039 0
D @JOB 244 253
D @USER 254 263
D @JOB# 264 269 0
D*
D InID S 11
D InDirection S 01
D InTrans S 15 5
D*
D ZeroBin S 1A INZ(*ALLX'00')
D NLZero S 2A INZ(X'1500')
D SI_Fmt S 50A INZ('\n')
D SI_FmtP S * INZ(%ADDR(SI_Fmt))
D SI_Msg S 50A
D SI_MsgP S * INZ(%ADDR(SI_Msg))
D Num_DS DS
D Num_Hex 4A INZ(X'00000000')
D Num 10I 0 OVERLAY(Num_Hex)
D Buf S 500A
D BufP S * INZ(%ADDR(Buf))
D BufLen S 10U 0
Dperror PR 10I 0 EXTPROC('perror')
Dconst * VALUE
Dsprintf PR 10I 0 EXTPROC('sprintf')
D * VALUE
D * VALUE
D 10I 0 VALUE OPTIONS(*NOPASS)
D * VALUE OPTIONS(*NOPASS)
* Open Operations
* value returned = file descriptor 0 (OK), -1 (Error)
Dopen PR 10I 0 EXTPROC('open')
D * VALUE
D 10I 0 VALUE
D 10U 0 VALUE OPTIONS(*NOPASS)
D 10U 0 VALUE OPTIONS(*NOPASS)
* Read Operations
* value returned = number of bytes read or , -1 (Error)
Dread PR 10I 0 EXTPROC('read')
D 10I 0 VALUE
D * Value
D 10U 0 VALUE
* Write Operations
* value returned = number of bytes Written or , -1 (Error)
Dwrite PR 10I 0 EXTPROC('write')
D 10I 0 VALUE
D * VALUE
D 10U 0 VALUE
* Close Operations
* value returned = 0 (OK) or , -1 (Error)
Dclose PR 10I 0 EXTPROC('close')
D 10I 0 VALUE
* Open Directory Operation
* value returned = file descriptor 0 (OK), -1 (Error)
Dopendir PR * EXTPROC('opendir')
D * VALUE
* Read Directory Operation
*
Dreaddir PR * EXTPROC('readdir')
D * VALUE
* Open Directory Operation
* value returned = 0 (OK) or , -1 (Error)
Dclosedir PR 10I 0 EXTPROC('closedir')
D * VALUE
* Unlink a File from system... Delete File
* value returned = 0 (OK) or , -1 (Error)
Dunlink PR 10I 0 EXTPROC('unlink')
D * VALUE
C *MDY Move UDATE ISODate
C Extrct ISODate:*Y Year
C Extrct ISODate:*M Month
C Extrct ISODate:*D Day
C Move Year Chr4
C Move Month Chr2
C Eval Chr4 = %Trim(Chr2) +
C %Trim(%Subst(Chr4:3:2))
C
C Clear Str
C 'MMYY' Scan FileNam Str
C If %Found
C Eval %Subst(FileNam:Str:4) = Chr4
C Endif
C*
C*
C*
C Z-add O_CREAT Oflag
C Add O_RDWR Oflag
C Add O_CODEPAGE Oflag
C EVAL FileDescr=open(FileNamP:Oflag:Omode:cp)
C IF FileDescr = -1
C EVAL RC = perror(FileNamP)
C Return
C ENDIF
C EVAL RC = close(FileDescr)
C IF RC = -1
C EVAL RC = perror(FileNamP)
C Return
C ENDIF
C Z-Add O_RDWR Oflag
C Add O_TEXTDATA Oflag
C EVAL FileDescr=open(FileNamP:Oflag)
C IF FileDescr = -1
C EVAL RC = perror(FileNamP)
C Return
C ENDIF
C*----------------------------------------------------------------
C* This is where the writting takes place
C*----------------------------------------------------------------
C EVAL Buf='This is a Test number 1' + X'25'
C *Start Setll RUAF015D
C Read RUAF015D
C Dow Not%Eof(RUAF015D)
C
C Eval %Subst(Big:001:11) = PRIME
C Eval %Subst(Big:016:30) = NXNAME
C Eval %Subst(Big:056:30) = NXADR1
c Eval %Subst(Big:086:30) = NXADR2
C
C* Chain to srbnam and get city, state, zipcode
C
C Movel(p) PRIME Customer
C Customer Chain SRBNAM
C If %Found(SRBNAM)
C Eval %Subst(Big:116:20) = NAADR4
C Eval %Subst(Big:136:02) = NASPCD
C Eval %Subst(Big:138:10) =
C %Trim(%Subst(NAPOCD:4:10))
C*
C* Country code
C*
C Eval %Subst(Big:281:05) = %Trim(NACOUN)
C Endif
C*
C* Chain to srbnfp for the phone number
C*
C Key01 Klist
C Kfld Customer
C KFLD Key#2
C Key01 Chain SRBNFP
C If %Found(SRBNFP)
C Eval %Subst(Big:148:10) =
C %Trim(%Subst(NFPHNO:1:3)) +
C %Trim(%Subst(NFPHNO:5:7))
C Endif
C
C*
C* take the date entered from customer master and send as date opened
C* format will be MMYY
C*
C Move NACRDT Chr8
C Eval %Subst(Big:158:04) =
C %Trim(%Subst(Chr8:5:2)) +
C %Trim(%Subst(Chr8:3:2))
C*
C* Create the run date
C*
C *MDY Move UDATE ISODate
C Extrct ISODate:*Y Year
C Extrct ISODate:*M Month
C Extrct ISODate:*D Day
C Move Month ChrMonth
C Move Day ChrDay
C Eval Chr8 = %Char(Month) + %Char(Day) +
C %Char(Year)
C Move Year Chr4
C Eval Chr2 = %Subst(Chr4:3:2)
C Eval Chr6 = %Trim(ChrMonth) + %Trim(ChrDay)
C + %Trim(Chr2)
C Eval %Subst(Big:162:06) = Chr6
C*
C* Create the last invoice MMYY format date
C*
C Customer Chain SRBNOI
C If %Found(SRBNOI)
C *ISO Test(De) NOLIND
C If Not%Error
C *ISO Move NOLIND ISODate
C Extrct ISODate:*Y Year
C Extrct ISODate:*M Month
C Extrct ISODate:*D Day
C Move Month ChrMonth
C Move Year Chr4
C Eval Chr2 = %Subst(Chr4:3:2)
C Eval Chr4 = %Trim(ChrMonth) + %Trim(Chr2)
C Eval %Subst(Big:168:08) = Chr4
C Endif
C Endif
C*
C* now do the balance, current and the 4 horsemen
C*
C If BALANCE < *Zeros
C Eval BALANCE = (BALANCE * -1)
C Eval Negative = 'Y'
C Else
C Eval Negative = 'N'
C Endif
C Move BALANCE Chr7
C*
C If Negative = 'Y'
C Eval %Subst(Big:172:08) = Chr7 +%Trim('-')
C Else
C Eval %Subst(Big:172:08) = '0' + %Trim(Chr7)
C Endif
C*
C* current
C*
C Eval Dec7 = CURRENT + NOTDUE
C*
C If Dec7 < *Zeros
C Eval Dec7 = (Dec7 * -1)
C Eval Negative = 'Y'
C Else
C Eval Negative = 'N'
C Endif
C*
C Move Dec7 Chr7
C If Negative = 'Y'
C Eval %Subst(Big:180:08) = Chr7 + %Trim('-')
C Else
C Eval %Subst(Big:180:08) = '0' + %Trim(Chr7)
C Endif
C*
C* 30 days past
C*
C If DUEM01 < *Zeros
C Eval DUEM01 = (DUEM01 * -1)
C Eval Negative = 'Y'
C Else
C Eval Negative = 'N'
C Endif
C Move DUEM01 Chr7
C If Negative = 'Y'
C Eval %Subst(Big:188:08) = Chr7 + %Trim('-')
C Else
C Eval %Subst(Big:188:08) = '0' + %Trim(Chr7)
C Endif
C*
C* 60 days past
C*
C If DUEM02 < *Zeros
C Eval DUEM02 = (DUEM02 * -1)
C Eval Negative = 'Y'
C Else
C Eval Negative = 'N'
C Endif
C Move DUEM02 Chr7
C If Negative = 'Y'
C Eval %Subst(Big:196:08) = Chr7 + %Trim('-')
C Else
C Eval %Subst(Big:196:08) = '0' + %Trim(Chr7)
C Endif
C*
C* 90 days past
C*
C If DUEM03 < *Zeros
C Eval DUEM03 = (DUEM03 * -1)
C Eval Negative = 'Y'
C Else
C Eval Negative = 'N'
C Endif
C Move DUEM03 Chr7
C If Negative = 'Y'
C Eval %Subst(Big:204:08) = Chr7 + %Trim('-')
C Else
C Eval %Subst(Big:204:08) = '0' + %Trim(Chr7)
C Endif
C*
C* Over 90 days past
C*
C If DUEM04 < *Zeros
C Eval DUEM04 = (DUEM04 * -1)
C Eval Negative = 'Y'
C Else
C Eval Negative = 'N'
C Endif
C Move DUEM04 Chr7
C If Negative = 'Y'
C Eval %Subst(Big:212:08) = Chr7 + %Trim('-')
C Else
C Eval %Subst(Big:212:08) = '0' + %Trim(Chr7)
C Endif
C*
C* Contact name
C*
C Eval %Subst(Big:241:20) = %Trim(NOCONT)
C*
C* write the line out.
C*
C EVAL Buf = Big + X'25'
C Movel(p) Big Buf
C Eval %Subst(Buf:500:1) = X'25'
C X'25' SCAN Buf BufLen 30
C EVAL RC = write(FileDescr: BufP: BufLen)
C Clear Big
C Clear Buf
C
C Read RUAF015D
C Enddo
C*
C*Shut down the IFS file and prepare to email.
C*
C Exsr $TheEnd
C*----------------------------------------------------------------
C* T H E E N D
C*----------------------------------------------------------------
CSR $TheEnd Begsr
C IF RC = -1
C EVAL RC = perror(FileNamP)
C Return
C ENDIF
C*
C* Close the File
C*
C EVAL RC = close(FileDescr)
C IF FileDescr = -1
C EVAL RC = perror(FileNamP)
C Return
C ENDIF
C*
C Eval *INLR = *On
C*
C Endsr
C*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-=-=-=-=
C* *INZSR - Initial one time run subroutine
C*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-=-=-=-=
CSR *INZSR Begsr
C*
C Endsr
C*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-=-=-=-=
H dftactgrp( *no ) bnddir( 'QC2LE' ) OPTION(*SRCSTMT : *NODEBUGIO)
H*============================================================
H*
H*============================================================
FRUAF015D IF E DISK
FSRBNAM IF E K DISK
FSRBNFP IF E K DISK
FSRBNOI IF E K DISK
D*
D RC S 10I 0
D FileNam S 20A INZ('/code400/File819.txt')
D FileNamP S * INZ(%ADDR(FileNam))
D FileDescr S 10I 0
D O_CREAT S 10I 0 INZ(8)
D O_RDWR S 10I 0 INZ(4)
D O_TEXTDATA S 10I 0 INZ(16777216)
D O_CODEPAGE S 10I 0 INZ(8388608)
D Oflag S 10I 0 INZ(0)
D Omode S 10U 0 INZ(511)
D cp S 10U 0 INZ(819)
D WorkEmail S 50
D CmdString S 512
D CmdLength S 15 5
D SendEmail S 50
D Len S 03 0
D*
D Big S 500
D Customer S 11
D Key#2 S 10 Inz('*PHONE')
D Chr7 S 07
D Dec7 S 07 0
D Chr8 S 08
D Chr4 S 04
D Chr6 S 06
D Negative S 01
D Chr2 S 02
D Month S 02 0
D ChrMonth S 02
D Year S 04 0
D Day S 02 0
D ChrDay S 02
D ISODate S D
D Str S 03 0
D Q C CONST('''')
D*
D* Program Info
D*
D SDS
D @PGM 001 010
D @PARMS 037 039 0
D @JOB 244 253
D @USER 254 263
D @JOB# 264 269 0
D*
D InID S 11
D InDirection S 01
D InTrans S 15 5
D*
D ZeroBin S 1A INZ(*ALLX'00')
D NLZero S 2A INZ(X'1500')
D SI_Fmt S 50A INZ('\n')
D SI_FmtP S * INZ(%ADDR(SI_Fmt))
D SI_Msg S 50A
D SI_MsgP S * INZ(%ADDR(SI_Msg))
D Num_DS DS
D Num_Hex 4A INZ(X'00000000')
D Num 10I 0 OVERLAY(Num_Hex)
D Buf S 500A
D BufP S * INZ(%ADDR(Buf))
D BufLen S 10U 0
Dperror PR 10I 0 EXTPROC('perror')
Dconst * VALUE
Dsprintf PR 10I 0 EXTPROC('sprintf')
D * VALUE
D * VALUE
D 10I 0 VALUE OPTIONS(*NOPASS)
D * VALUE OPTIONS(*NOPASS)
* Open Operations
* value returned = file descriptor 0 (OK), -1 (Error)
Dopen PR 10I 0 EXTPROC('open')
D * VALUE
D 10I 0 VALUE
D 10U 0 VALUE OPTIONS(*NOPASS)
D 10U 0 VALUE OPTIONS(*NOPASS)
* Read Operations
* value returned = number of bytes read or , -1 (Error)
Dread PR 10I 0 EXTPROC('read')
D 10I 0 VALUE
D * Value
D 10U 0 VALUE
* Write Operations
* value returned = number of bytes Written or , -1 (Error)
Dwrite PR 10I 0 EXTPROC('write')
D 10I 0 VALUE
D * VALUE
D 10U 0 VALUE
* Close Operations
* value returned = 0 (OK) or , -1 (Error)
Dclose PR 10I 0 EXTPROC('close')
D 10I 0 VALUE
* Open Directory Operation
* value returned = file descriptor 0 (OK), -1 (Error)
Dopendir PR * EXTPROC('opendir')
D * VALUE
* Read Directory Operation
*
Dreaddir PR * EXTPROC('readdir')
D * VALUE
* Open Directory Operation
* value returned = 0 (OK) or , -1 (Error)
Dclosedir PR 10I 0 EXTPROC('closedir')
D * VALUE
* Unlink a File from system... Delete File
* value returned = 0 (OK) or , -1 (Error)
Dunlink PR 10I 0 EXTPROC('unlink')
D * VALUE
C *MDY Move UDATE ISODate
C Extrct ISODate:*Y Year
C Extrct ISODate:*M Month
C Extrct ISODate:*D Day
C Move Year Chr4
C Move Month Chr2
C Eval Chr4 = %Trim(Chr2) +
C %Trim(%Subst(Chr4:3:2))
C
C Clear Str
C 'MMYY' Scan FileNam Str
C If %Found
C Eval %Subst(FileNam:Str:4) = Chr4
C Endif
C*
C*
C*
C Z-add O_CREAT Oflag
C Add O_RDWR Oflag
C Add O_CODEPAGE Oflag
C EVAL FileDescr=open(FileNamP:Oflag:Omode:cp)
C IF FileDescr = -1
C EVAL RC = perror(FileNamP)
C Return
C ENDIF
C EVAL RC = close(FileDescr)
C IF RC = -1
C EVAL RC = perror(FileNamP)
C Return
C ENDIF
C Z-Add O_RDWR Oflag
C Add O_TEXTDATA Oflag
C EVAL FileDescr=open(FileNamP:Oflag)
C IF FileDescr = -1
C EVAL RC = perror(FileNamP)
C Return
C ENDIF
C*----------------------------------------------------------------
C* This is where the writting takes place
C*----------------------------------------------------------------
C EVAL Buf='This is a Test number 1' + X'25'
C *Start Setll RUAF015D
C Read RUAF015D
C Dow Not%Eof(RUAF015D)
C
C Eval %Subst(Big:001:11) = PRIME
C Eval %Subst(Big:016:30) = NXNAME
C Eval %Subst(Big:056:30) = NXADR1
c Eval %Subst(Big:086:30) = NXADR2
C
C* Chain to srbnam and get city, state, zipcode
C
C Movel(p) PRIME Customer
C Customer Chain SRBNAM
C If %Found(SRBNAM)
C Eval %Subst(Big:116:20) = NAADR4
C Eval %Subst(Big:136:02) = NASPCD
C Eval %Subst(Big:138:10) =
C %Trim(%Subst(NAPOCD:4:10))
C*
C* Country code
C*
C Eval %Subst(Big:281:05) = %Trim(NACOUN)
C Endif
C*
C* Chain to srbnfp for the phone number
C*
C Key01 Klist
C Kfld Customer
C KFLD Key#2
C Key01 Chain SRBNFP
C If %Found(SRBNFP)
C Eval %Subst(Big:148:10) =
C %Trim(%Subst(NFPHNO:1:3)) +
C %Trim(%Subst(NFPHNO:5:7))
C Endif
C
C*
C* take the date entered from customer master and send as date opened
C* format will be MMYY
C*
C Move NACRDT Chr8
C Eval %Subst(Big:158:04) =
C %Trim(%Subst(Chr8:5:2)) +
C %Trim(%Subst(Chr8:3:2))
C*
C* Create the run date
C*
C *MDY Move UDATE ISODate
C Extrct ISODate:*Y Year
C Extrct ISODate:*M Month
C Extrct ISODate:*D Day
C Move Month ChrMonth
C Move Day ChrDay
C Eval Chr8 = %Char(Month) + %Char(Day) +
C %Char(Year)
C Move Year Chr4
C Eval Chr2 = %Subst(Chr4:3:2)
C Eval Chr6 = %Trim(ChrMonth) + %Trim(ChrDay)
C + %Trim(Chr2)
C Eval %Subst(Big:162:06) = Chr6
C*
C* Create the last invoice MMYY format date
C*
C Customer Chain SRBNOI
C If %Found(SRBNOI)
C *ISO Test(De) NOLIND
C If Not%Error
C *ISO Move NOLIND ISODate
C Extrct ISODate:*Y Year
C Extrct ISODate:*M Month
C Extrct ISODate:*D Day
C Move Month ChrMonth
C Move Year Chr4
C Eval Chr2 = %Subst(Chr4:3:2)
C Eval Chr4 = %Trim(ChrMonth) + %Trim(Chr2)
C Eval %Subst(Big:168:08) = Chr4
C Endif
C Endif
C*
C* now do the balance, current and the 4 horsemen
C*
C If BALANCE < *Zeros
C Eval BALANCE = (BALANCE * -1)
C Eval Negative = 'Y'
C Else
C Eval Negative = 'N'
C Endif
C Move BALANCE Chr7
C*
C If Negative = 'Y'
C Eval %Subst(Big:172:08) = Chr7 +%Trim('-')
C Else
C Eval %Subst(Big:172:08) = '0' + %Trim(Chr7)
C Endif
C*
C* current
C*
C Eval Dec7 = CURRENT + NOTDUE
C*
C If Dec7 < *Zeros
C Eval Dec7 = (Dec7 * -1)
C Eval Negative = 'Y'
C Else
C Eval Negative = 'N'
C Endif
C*
C Move Dec7 Chr7
C If Negative = 'Y'
C Eval %Subst(Big:180:08) = Chr7 + %Trim('-')
C Else
C Eval %Subst(Big:180:08) = '0' + %Trim(Chr7)
C Endif
C*
C* 30 days past
C*
C If DUEM01 < *Zeros
C Eval DUEM01 = (DUEM01 * -1)
C Eval Negative = 'Y'
C Else
C Eval Negative = 'N'
C Endif
C Move DUEM01 Chr7
C If Negative = 'Y'
C Eval %Subst(Big:188:08) = Chr7 + %Trim('-')
C Else
C Eval %Subst(Big:188:08) = '0' + %Trim(Chr7)
C Endif
C*
C* 60 days past
C*
C If DUEM02 < *Zeros
C Eval DUEM02 = (DUEM02 * -1)
C Eval Negative = 'Y'
C Else
C Eval Negative = 'N'
C Endif
C Move DUEM02 Chr7
C If Negative = 'Y'
C Eval %Subst(Big:196:08) = Chr7 + %Trim('-')
C Else
C Eval %Subst(Big:196:08) = '0' + %Trim(Chr7)
C Endif
C*
C* 90 days past
C*
C If DUEM03 < *Zeros
C Eval DUEM03 = (DUEM03 * -1)
C Eval Negative = 'Y'
C Else
C Eval Negative = 'N'
C Endif
C Move DUEM03 Chr7
C If Negative = 'Y'
C Eval %Subst(Big:204:08) = Chr7 + %Trim('-')
C Else
C Eval %Subst(Big:204:08) = '0' + %Trim(Chr7)
C Endif
C*
C* Over 90 days past
C*
C If DUEM04 < *Zeros
C Eval DUEM04 = (DUEM04 * -1)
C Eval Negative = 'Y'
C Else
C Eval Negative = 'N'
C Endif
C Move DUEM04 Chr7
C If Negative = 'Y'
C Eval %Subst(Big:212:08) = Chr7 + %Trim('-')
C Else
C Eval %Subst(Big:212:08) = '0' + %Trim(Chr7)
C Endif
C*
C* Contact name
C*
C Eval %Subst(Big:241:20) = %Trim(NOCONT)
C*
C* write the line out.
C*
C EVAL Buf = Big + X'25'
C Movel(p) Big Buf
C Eval %Subst(Buf:500:1) = X'25'
C X'25' SCAN Buf BufLen 30
C EVAL RC = write(FileDescr: BufP: BufLen)
C Clear Big
C Clear Buf
C
C Read RUAF015D
C Enddo
C*
C*Shut down the IFS file and prepare to email.
C*
C Exsr $TheEnd
C*----------------------------------------------------------------
C* T H E E N D
C*----------------------------------------------------------------
CSR $TheEnd Begsr
C IF RC = -1
C EVAL RC = perror(FileNamP)
C Return
C ENDIF
C*
C* Close the File
C*
C EVAL RC = close(FileDescr)
C IF FileDescr = -1
C EVAL RC = perror(FileNamP)
C Return
C ENDIF
C*
C Eval *INLR = *On
C*
C Endsr
C*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-=-=-=-=
C* *INZSR - Initial one time run subroutine
C*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-=-=-=-=
CSR *INZSR Begsr
C*
C Endsr
C*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-=-=-=-=
No comments:
Post a Comment