RPG IV Source, SPR201
RPG IV Source, SPR201
H dftactgrp(*no)
H actgrp(*CALLER)
H option(*NODEBUGIO:*SrcStmt)
F****************************************************************
F* SPR201 - Display outq, allow email/fax/print of spool files *
F****************************************************************
FSPF201 CF E Workstn
F Sfile(Detail:rrn1)
F Sfile(EmlDtl:rrn2)
D******************
D* Work fields *
D******************
D Msg S 75 Dim(12) CtData PerRcd(1)
D CmdMsg S 50 Dim(2) CtData PerRcd(1)
D Cmd S 256
D CmdLen S 15 5
D Count S 5 0
D EmailFlag S 1 Inz('N')
D IpNewOutq S 10
D Ix S 3 0
D JobInfo S 26
D OpFile S 10
D OpFax# S 15
D OpFaxExtn S 4
D OpOutq S 20
D OpSpoolNbr S 6
D Rrn1 S 4 0
D Rrn2 S 4 0
D MoveFmtLen S 10I 0
D MoveFmtName S 8
D SpoolAttLen S 10I 0
D SpoolFmtNam1 S 8
D SpoolFmtNam2 S 8
D SpoolFName S 10
D SpoolFNbr S 10I 0
D SpaceAuth S 10 Inz('*ALL ')
D SpaceDomain S 10 Inz('*USER ')
D SpaceExtAtt S 10
D SpaceInit S 1 inz(x'00')
D SpaceName S 20 Inz('MOVSPLF QTEMP ')
D SpaceRepl S 10 Inz('*YES ')
D SpaceRtvLen S 10I 0
D SpaceSize S 10I 0
D SpaceStrPos S 10I 0
D SpaceText S 50 Inz('MOVE SPOOL FILES')
D SpoolsMax S 1350
D UsersName S 10
D UserFormTyp S 10
D UserData S 10
D Subject S 70
D SenderName S 50
D SenderAddr S 50
D EdtFMbr S 4
D ImportNc S 4 Inz('*MED')
D Priority S 4 Inz('*NRM')
D Sensitiv S 4 Inz('*NRM')
D ReplyTo S 50 Inz('*FROMADDR')
D Receipt S 4 Inz('*NO')
D Savedir S 60 Inz('*NONE')
D PDFSavedir S 60 Inz('*NONE')
D******************
D* Data structures*
D******************
D ToList DS
D NbrTo 1 2b 0
D ToArr 104a Dim(50)
D DS
D ToElem 1 104a
D toccbcc 1 1a
D toname 5 54a
D toaddr 55 104a
D*
D SplFList DS
D NbrSplF 1 2b 0
D SplFArr 44a Dim(50)
D DS
D SplFElem 1 44a
D SplF 1 10a
D JobNam 11 20a
D JobUsr 21 30a
D JobNbr 31 36a
D SplFNbrX 37 40b 0
D CvtPdf 41 44a
D MsgM ds
D MsgMMbr 1 10a
D MsgMFil 11 20a
D MsgMLib 21 30a
D*
D/Include QSYSINC/QRPGLESRC,QUSGEN
D/Include QSYSINC/QRPGLESRC,QUSLSPL
D/Include QSYSINC/QRPGLESRC,QUSRSPLA
D/Include QSYSINC/QRPGLESRC,QSPMOVSP
D****************************************************************
D*RECORD STRUCTURE FOR ERROR CODE PARAMETER *
D*NOTE: THE FOLLOWING TYPE DEFINITION ONLY DEFINES THE FIXED *
D* PORTION OF THE FORMAT. VARYING LENGTH FIELD EXCEPTION *
D* DATA WILL NOT BE DEFINED HERE. *
D****************************************************************
DQUSEC DS
D* Qus EC
D QUSBPRV 1 4B 0
D* Bytes Provided
D QUSBAVL 5 8B 0
D* Bytes Available
D QUSEI 9 15
D* Exception Id
D QUSERVED 16 16
D* Varying length
D ERRDTA 17 116
C******************
C* Entry parameters
C******************
C *Entry Plist
C Parm IpNewOutq
C******************
C* Initialization *
C******************
C Emails Plist
C Parm Subject
C Parm SenderName
C Parm SenderAddr
C Parm ToList
C Parm SplFList
C Parm MsgM
C Parm EdtFMbr
C Parm ImportNc
C Parm Priority
C Parm Sensitiv
C Parm ReplyTo
C Parm Receipt
C Parm Savedir
C Parm PDFSavedir
C*
C Eval WNOUTQ = IpNewOutq
C Eval *IN(*) = '0'
C Eval *IN32 = '1'
C Eval Rrn1 = 0
C Exsr Build
C****************************************************************
C* Mainline processing *
C****************************************************************
C Dow *IN03 = '0'
C Write FOOTER
C Exfmt HEADER
C Eval ERRMSG = *Blanks
C*
C Select
C* Exit....
C When *IN03 = '1'
C* Any moves...
C When Rrn1 > 0
C Exsr Check
C If ERRMSG = *Blanks
C Exsr Build
C Endif
C* Reload data...
C Other
C Exsr Build
C Endsl
C Enddo
C* Finished...
C Eval *INLR = '1'
C****************************************************************
C* Build - Load anything in the selected outq. *
C****************************************************************
C Build Begsr
C If ERRMSG = *Blanks
C*
C Eval WCPICK = *Blanks
C Eval *IN31 = '0'
C Eval *IN32 = '0'
C Eval *IN38 = '0'
C Write Header
C Eval Rrn1 = 0
C Eval *IN32 = '1'
C Clear QUSEC
C Eval Qusbprv = 100
C Eval Qusbavl = 100
C* Create user space...
C Call 'QUSCRTUS'
C Parm SpaceName
C Parm *Blanks SpaceExtAtt
C Parm 1024 SpaceSize
C Parm SpaceInit
C Parm SpaceAuth
C Parm SpaceText
C Parm SpaceRepl
C Parm QUSEC
C Parm SpaceDomain
C* Fill with outq data...
C Call 'QUSLSPL '
C Parm SpaceName
C Parm 'SPLF0100' SpoolFmtNam1
C Parm '*CURRENT' UsersName
C Parm '*ALL ' opoutq
C Parm '*ALL ' UserFormTyp
C Parm '*ALL ' UserData
C Parm QUSEC
C* Get data from user space....
C Eval SpaceRtvLen = 140
C Eval SpaceStrPos = 1
C Call 'QUSRTVUS'
C Parm SpaceName
C Parm SpaceStrPos
C Parm SpaceRtvLen
C Parm Qush0100
C Parm QUSEC
C* Setup extract parms...
C Eval SpaceStrPos = (Qusold + 1)
C Eval SpaceRtvLen = Qussee
C Eval SpoolAttLen = 209
C Eval Count = 1
C* Pull out info loop....
C Dow COUNT 0
C Eval NbrSplf= Ix
C* Use validity checker...
C Call(e) 'EMLSPLVCKR' Emails
C* Ok?...
C If Not %ERROR
C Call 'EMLSPL ' Emails
C Leave
C Else
C Eval ERRMSG2 = Msg(11)
C Endif
C Endif
C Endif
C*
C Enddo
C Endsr
C****************************************************************
C* SendFax - Take selection to Fax. *
C****************************************************************
C SendFax Begsr
C Dow *IN03 = '0'
C Exfmt FAXPMT
C Eval ERRMSG2 = *Blanks
C*
C Select
C When *IN03 = '1'
C Eval *IN03 = '0'
C Leave
C*
C When WBFAX# = 0
C Eval ERRMSG2 = Msg(10)
C Other
C Eval OpFax# = %Trim(%Editc(WBFAX#:'4'))
C If WBFEXT > 0
C Eval OpFaxExtn = %Char(WBFEXT)
C Endif
C Eval OpSpoolNbr = %Char(FLENBR)
C Call 'SPC200F '
C Parm OpFax#
C Parm OpFaxExtn
C Parm WBLDIST
C Parm REPORT OpFile
C Parm JOB
C Parm JOBNBR
C Parm USER
C Parm OpSpoolNbr
C Leave
C Endsl
C Enddo
C Endsr
C****************************************************************
C* Show - Display theo spool file. *
C****************************************************************
C Show Begsr
C Eval Cmd = 'DSPSPLF FILE(' + %Trim(REPORT) +
C ') JOB(' + JOBNBR + '/' +
C %Trim(USER) + '/' + %Trim(JOB) +
C ') SPLNBR(' + %Editc(FLENBR:'X') + ')'
C Eval CmdLen = %Checkr(' ':Cmd)
C Call 'QCMDEXC ' 99
C Parm Cmd
C Parm CmdLen
C Endsr
C****************************************************************
** Msg
1 - Missing or Invalid From Outq Name. Please correct and try again.
2 - Missing or Invalid New Outq Name. Please correct and try again.
3 - Email subject is required.
4 - Email FROM name is required.
5 - Email FROM address is required.
6 - Invalid FROM email account. Must contain the @ sign.
7 - Email TO name is required.
8 - Email TO address is required.
9 - Invalid TO email account. Must contain the @ sign.
10 - Fax number is 0 or missing.
11 - Email Info failed validity check. See job log.
12 - Type of Delivery must be *TO, *CC, *BCC.
** CmdMsg
CHKOBJ OBJ(*LIBL/
OBJTYPE(*OUTQ)
DDS for display file SPF201
A
A DSPSIZ(24 80 *DS3)
A REF(*LIBL/OIFREF)
A CHGINPDFT(HI UL)
A PRINT
A ENTFLDATR((*COLOR YLW) (*DSPATR UL))
A CA03(03)
A R DETAIL SFL
A 38 SFLNXTCHG
A WCPICK 1A B 9 3
A 31 DSPATR(PC)
A REPORT 10 O 9 5
A 41 COLOR(TRQ)
A 42 COLOR(YLW)
A 43 COLOR(RED)
A JOB 10A O 9 16
A USER 10A O 9 27
A JOBNBR 6A O 9 38
A FLENBR 6Y 0O 9 45EDTCDE(4)
A FORMTP 10A O 9 52
A USRDTA 10A O 9 63
A PAGES 5Y 0O 9 74EDTCDE(4)
A R HEADER SFLCTL(DETAIL)
A SFLSIZ(0100)
A SFLPAG(0012)
A OVERLAY
A 31 SFLDSP
A 32 SFLDSPCTL
A N32 SFLCLR
A N34 SFLEND(*MORE)
A 1 2USER
A 1 22'List of Spool Files to Print/Fax/E-
A mail'
A DSPATR(HI)
A DSPATR(UL)
A 1 71DATE
A EDTCDE(Y)
A 2 71TIME
A 4 12'Move Selected to New Outq:'
A WNOUTQ 10A B 4 39
A 6 5'Options:'
A 6 15'1=Move to Outq'
A COLOR(BLU)
A DSPATR(UL)
A 6 33'2=Email'
A COLOR(BLU)
A DSPATR(UL)
A 6 44'3=Fax'
A COLOR(BLU)
A DSPATR(UL)
A 6 53'5=Display'
A DSPATR(UL)
A COLOR(BLU)
A 8 2'Opt Report Nm Job Name User Name-
A Job # Splf # Form Type User Dat-
A a Pages'
A DSPATR(HI)
A DSPATR(UL)
A*
A R FOOTER
A 23 4'F3=Exit'
A 23 38'Press enter to Process Selections'
A ERRMSG 75A O 24 3DSPATR(HI)
A R EMLDTL SFL
A 68 SFLNXTCHG
A 9 4'Type of Email..:'
A WBTYPE 4A B 9 21
A 9 27'(*TO *CC *BCC)'
A 10 4'To User Name:..:'
A WBTONME 30A B 10 21
A 11 4'To User Address:'
A WBMAIL 40A B 11 21CHECK(LC)
A R EMLHDR SFLCTL(EMLDTL)
A SFLSIZ(0020)
A SFLPAG(0001)
A WINDOW(EMLFTR)
A OVERLAY
A 61 SFLDSP
A 62 SFLDSPCTL
A N61 SFLINZ
A N64 SFLEND(*MORE)
A 1 2USER
A 1 20'Enter Email Addressing Information'
A DSPATR(UL)
A DSPATR(HI)
A 1 57'(SPR201)'
A 3 2'From:'
A DSPATR(UL)
A 4 2'Email Subject.:'
A WBSUBJ 40A B 4 18
A 5 2'From User Name:'
A WBFRMNME 30A B 5 18
A 6 2'From User Addr:'
A WBFRMADR 40A B 6 18CHECK(LC)
A 8 2'To:'
A DSPATR(UL)
A 8 7'(Page down for More...)'
A DSPATR(HI)
A R EMLFTR
A OVERLAY
A WINDOW(3 8 18 65 *NOMSGLIN)
A WDWBORDER((*COLOR BLU) (*DSPATR RI)-
A (*CHAR ' '))
A 13 2'Message Body Source Member:'
A WBMBNM 10 B 13 30
A 13 41'(*TEMP, *NONE, Name)'
A 14 2'Message Body Source File Name:'
A WBFNAM 10 B 14 33
A 14 44'Library:'
A WBLNAM 10 B 14 53
A 15 2'Edit Message Source Member:'
A WBEDIT 1 B 15 30
A 15 33'( Y or N)'
A 17 2'F3=Exit'
A 17 14'Press Enter to Send Email'
A 17 45'Page Down for More'
A ERRMSG2 58A O 18 1DSPATR(HI)
A R FAXPMT
A WINDOW(5 8 15 60 *NOMSGLIN)
A WDWBORDER((*COLOR BLU) (*DSPATR RI)-
A (*CHAR ' '))
A 1 16'Enter Fax Number Information'
A DSPATR(UL)
A DSPATR(HI)
A 1 52'(SPF201)'
A 5 3'Number to Fax to:'
A WBFAX# 15Y 0B 5 21EDTCDE(4)
A 5 38'Extension:'
A WBFEXT 4Y 0B 5 49EDTCDE(4)
A 5 54'(Opt.)'
A 7 4'Is this Long Distance?'
A WBLDIST 1A B 7 28VALUES('Y' 'N')
A 13 20'Press Enter to Send Fax'
A 14 2'F3=Exit'
A ERRMSG2 58A O 15 1DSPATR(HI)
CMD source for SPR201
CMD PROMPT('Spool File Utilities Prompt')
PARM KWD(NEWOUTQ) TYPE(*CHAR) LEN(10) +
CHOICE('Valid Outq Name') +
PROMPT('Destination Outq Name . . . .:')
CL source for external fax processing
PGM PARM(&FAX# &EXTN &LONGD &FILE &JOBNAME +
&JOBNBR &USERNAME &SPLNBR)
DCL VAR(&DIAL#) TYPE(*CHAR) LEN(25)
DCL VAR(&EXTN) TYPE(*CHAR) LEN(4)
DCL VAR(&FAX#) TYPE(*CHAR) LEN(15)
DCL VAR(&FILE) TYPE(*CHAR) LEN(10)
DCL VAR(&LONGD) TYPE(*CHAR) LEN(1)
DCL VAR(&JOBNAME) TYPE(*CHAR) LEN(10)
DCL VAR(&USERNAME) TYPE(*CHAR) LEN(10)
DCL VAR(&JOBNBR) TYPE(*CHAR) LEN(6)
DCL VAR(&SPLNBR) TYPE(*CHAR) LEN(6)
DCL VAR(&PIN#) TYPE(*CHAR) LEN(4) VALUE('0517')
/* IS LONG DISTANCE..... */
IF COND(&LONGD = 'Y') THEN(DO)
IF COND(&EXTN = ' ') THEN(DO)
CHGVAR VAR(&DIAL#) VALUE('+1' *CAT &Fax# *TCAT +
'?' *TCAT &PIN#)
ENDDO
ELSE CMD(DO)
CHGVAR VAR(&DIAL#) VALUE('+1' *CAT &Fax# *TCAT +
'?' *TCAT &PIN# *TCAT '%%' *TCAT &EXTN)
ENDDO
ENDDO
/* NOT LONG DISTANCE..... */
ELSE CMD(DO)
IF COND(&EXTN = ' ') THEN(DO)
CHGVAR VAR(&DIAL#) VALUE('+' *CAT &Fax#)
ENDDO
ELSE CMD(DO)
CHGVAR VAR(&DIAL#) VALUE('+' *CAT &Fax# *TCAT +
'%%' *TCAT &EXTN)
ENDDO
ENDDO
SNDFAX TO((&DIAL#)) FILE(&FILE) +
JOB(&JOBNBR/&USERNAME/&JOBNAME) +
SPLNBR(&SPLNBR) MODE(*NORMAL)
DLYJOB DLY(3)
ENDPGM
................
................
In order to avoid copyright disputes, this page is only a partial summary.
To fulfill the demand for quickly locating and searching documents.
It is intelligent file search solution for home and business.