*-********************************************************************
*-
*-
*-
*-
*-
*- Realizado por el Analista:
*-
*- --** Leonardo Arévalo **--
*- --** 06-09-2007 **--
*-
*-********************************************************************
H DECEDIT('0,') DATEDIT(*DMY/)
FSMSTEM01 UP A E K DISK PREFIX(SMST_)
FSMSPF02 IF A E K DISK PREFIX(SMS1_)
FSMSTXT2 O E DISK
FSMSLI01 IF E K DISK PREFIX(SMS_)
D
//definir data struc para sql
D DS
D XFECHA1 1 8 0
D XANOD 1 4 0
D XMESD 5 6 0
D XDIAD 7 8 0
D
*------------------------------
* FECHA VENCIMIENTO PARA MSG -
*------------------------------
D DS
D FECVEN 1 10
D DIAVEN 1 2 0
D ESLA1 3 3 INZ('/')
D MESVEN 4 5 0
D ESLA2 6 6 INZ('/')
D AÑOVEN 7 10 0
*-------------------------------------
*-------------------------------------
* FECHA DESDE
*-------------------------------------
D DS
D DESDE 1 8 0
D DIADES 1 2 0
D MESDES 3 4 0
D AÑODES 5 8 0
*-------------------------------------
* FECHA INVERTIDA
*-------------------------------------
D DS
D FECINV 1 8 0
D DIAINV 7 8 0
D MESINV 5 6 0
D AÑOINV 1 4 0
*-------------------------------------
* FECHA DE VENCIMIENTO *
*-------------------------------------
D DS
D FECVCT 1 8 0
D DIVCT 7 8 0
D MEVCT 5 6 0
D AÑVCT 1 4 0
*-------------------------------------
* FECHA 1 FECVCT
*-------------------------------------
D DS
D FECHA1 1 8 0
D DIAFE1 1 2 0
D MESFE1 3 4 0
D ANOFE1 5 8 0
*-------------------------------------
* FECHA 2 PARAMETROS
*-------------------------------------
D DS
D FECHA2 1 8 0
D DIAFE2 1 2 0
D MESFE2 3 4 0
D ANOFE2 5 8 0
*-------------------------------------
* FECHA 2 PARAMETROS
*-------------------------------------
D DS
D FEC4 1 8 0
D DIA4 1 2 0
D MES4 3 4 0
D ANO4 5 8 0
*-------------------------------------------------------------
D TIPCOB1 S 1S 0
D NGIR1 S 2S 0
D DIASV1 S 2S 0
D CDCON1 S 1S 0
D TIPOP S 1S 0
D MONTC S 15
D CELULAR S 11
D AAAAMMDD1 S D DATFMT(*ISO)
D AAAAMMDD2 S D DATFMT(*ISO)
D XFEC1 S D DATFMT(*EUR)
D XFEC2 S D DATFMT(*EUR)
D XFEC1R S D DATFMT(*EUR)
D XFEC2R S D DATFMT(*EUR)
D AAAAMMDD3 S 8 0
D FEC1 S 8
D FEC2 S 8
D FEC3 S 8
D*FEC4 S 8
D METOD S 1
D MES1 S 2 0
D MES2 S 2
D PAS S 1 0 INZ(0)
D TEXTO2 S 144A
*-------------------------------------------------------------
* b.nrreg,b.nrgir,b.aÑvct,b.mevct,b.divct,b.mongi,b.cdcon
D REGISTRO DS
D SQLTELEFONO 12S 0
D SNRREG 6S 0
D SNRGIR 3S 0
D SAÑVCT 4S 0
D SMEVCT 2S 0
D SDIVCT 2S 0
D SMONGI 15S 2
D SCDCON 1S 0
D SZONAT 4S 0
*
ISMSTEMR
I SMST_NRREG L1
C
*-********************************************************************
*- El inicio del programa esta contenido en la rutina (*inzsr)
*- esta intruccion se ejecuta primiero e luego el resto del programa
*-********************************************************************
C
*--
C Z-ADD SMST_DIVCT DIAFE1
C Z-ADD SMST_MEVCT MESFE1
C Z-ADD SMST_AÑVCT ANOFE1
*--
C MOVE SMST_TELEFO CELULAR
*-
C L1 EVAL GIROS=0
C L1 EVAL TOTDEU=0
C* Valida la fecha desde
C *EUR TEST (D) FECHA1 35
*
C IF *IN35=*OFF AND *IN36=*OFF
C *EUR MOVE FECHA1 XFEC1
C ENDIF
*-
C IF *IN35=*OFF AND *IN36=*OFF
C
C ADD SMST_MONGI TOTDEU 13 2
C MOVE SMST_NRGIR NUMGIR 2
C ADD 1 GIROS 2 0
C Z-ADD SMST_DIVCT DIAVEN
C Z-ADD SMST_MEVCT MESVEN
C Z-ADD SMST_AÑVCT AÑOVEN
C MOVE SMST_NRREG FINANC 6
C EVAL CDCON1=SMST_CDCON
C ENDIF
*
C*1 EXSR RUTL1
*-genera txt
CL1 EXSR GENERA_TXT
C
C*R WRITE RTOTGE
C
*-********************************************************************
*- fin de PGM
*-********************************************************************
C
*-********************************************************************
*-genera txt
*-********************************************************************
C GENERA_TXT BEGSR
C
C MOVE SMST_TELEFO TELEFON 12
*- establecer parametros
C EVAL TIPOP=0
*---------------------------------------------------------------------
*- valida fecha
*
*-5 dias despues
*1.
C IF XFEC1R=XFEC1
C IF GIROS=1
*--5 dias antes del 1er vencimiento
C EVAL TIPOP=1
C MOVEL XFEC1 FECVEN
C ELSE
C IF GIROS=2
*--5 dias antes del 2do vencimiento
C EVAL TIPOP=3
C MOVEL XFEC1 FECVEN
C ENDIF
C ENDIF
C ENDIF
*2.
*-5 dias antes
C IF XFEC2R=XFEC1
C IF GIROS=1
*-5 dias despues del vencimiento
C EVAL TIPOP=2
C MOVEL XFEC1 FECVEN
C ELSE
C IF GIROS=2
C MOVEL XFEC1 FECVEN
C ENDIF
C ENDIF
C ENDIF
C
*-si vence la segunda cuota
C IF XFEC1=XFEC2 AND GIROS=2
C EVAL TIPOP=4
C MOVEL XFEC1 FECVEN
C ENDIF
C
*-*-------------------------------------------------------------------
*-se genera sms
C IF TIPOP<>0
*-monto
C EVAL MONTC=*BLANKS
C EVAL MONTC=%EDITC(TOTDEU:'N')
* parametros
C EVAL TIPCOB1=CDCON1
C EVAL DIASV1=TIPOP
C EVAL ESLA1='/'
C EVAL ESLA2='/'
*--genera el sms
C EXSR GENERA_SMS
*--graba sms
C EXSR GRABA_SMS
C ENDIF
*-*-------------------------------------------------------------------
*--sms continuos al mensages inicial
C IF (TIPOP=2 OR TIPOP=3 OR TIPOP=4)
C AND ( %SCAN('infructuosa':TEXTO2) = 0 )
C EVAL TIPOP=5
* parametros
C EVAL TIPCOB1=0
C EVAL DIASV1=TIPOP
*--genera el sms
C EXSR GENERA_SMS
*--graba sms
C EXSR GRABA_SMS
C ENDIF
*-*-------------------------------------------------------------------
*--sms continuos al mensages inicial 15,30
C EVAL METOD='A'
C EVAL FEC1='15'+%EDITC(*MONTH:'X')+%CHAR(*YEAR)
C EVAL FEC2=%EDITC(*DATE:'X')
*-verifica dia habil mas cercano
C EXSR FECHA_HAB
C
C IF FEC2=FEC3 AND CDCON1=02
C OR
C FEC2=FEC3 AND CDCON1=01
C
C EVAL TIPOP=6
* parametros
C EVAL TIPCOB1=0
C EVAL DIASV1=TIPOP
*--genera el sms
C EXSR GENERA_SMS
*--graba sms
C EXSR GRABA_SMS
C ENDIF
C
C* IF PAS=1
C* EVAL PAS=0
C* EXSR GRABAARC_SMS
C* ENDIF
C
C MOVE *BLANKS TEXTO
C ENDSR
*-********************************************************************
*- Rutina que genera SMS
*-********************************************************************
C GENERA_SMS BEGSR
C
C MOVEL *BLANKS TEXTO2
C KEYSMS CHAIN SMSLI01
C IF %FOUND(SMSLI01)
C MOVE SMS_CODSMS CODSM 3
C MOVE SMST_TELEFO TCELU 12
C MOVE FECVEN TFECHA 10
C MOVE MONTC TMONTO 15
C MOVE NUMGIR TNROGI 2
C MOVE GIROS TNROGN 2
C MOVE *ZEROS TXCONV 180
C MOVE SMST_CDZNA TXZONT 4
C CALL 'SRPD34'
C PARM CODSM
C PARM TCELU
C PARM TFECHA
C PARM TMONTO
C PARM TNROGI
C PARM TNROGN
C PARM TXCONV
C PARM TXZONT
C MOVEL TXCONV TEXTO2
C* MOVE TEXTO2 TEXTO
C ENDIF
C
C ENDSR
*-********************************************************************
*- Rutina que indica el dia habil mas cercano
*-********************************************************************
C FECHA_HAB BEGSR
C
C MOVE *BLANKS FEC3
C CALL 'SRPD35'
C PARM FEC1
C PARM FEC3
C PARM METOD
C
C ENDSR
*-********************************************************************
*- Rutina que graba SMS
*-********************************************************************
C GRABA_SMS BEGSR
C EVAL PAS=1
C IF TEXTO2<>*BLANKS
C EVAL TEXTO=CELULAR+';'+TEXTO2
C WRITE MSGTXT
C EXSR GRABAARC_SMS
C ENDIF
C
C ENDSR
*--*******************************************************************
*- Rutina que actualiza archivo sms
*--*******************************************************************
C GRABAARC_SMS BEGSR
C EVAL SMS1_NRREG=SMST_NRREG
C EVAL SMS1_NRGIR=SMST_NRGIR
C EVAL SMS1_AÑVCT=SMST_AÑVCT
C EVAL SMS1_MEVCT=SMST_MEVCT
C EVAL SMS1_DIVCT=SMST_DIVCT
C EVAL SMS1_MONGI=SMST_MONGI
C EVAL SMS1_CDCON=SMST_CDCON
C EVAL SMS1_TELEFO=SMST_TELEFO
C EVAL SMS1_FECEMI=AAAAMMDD1
C EVAL SMS1_DETSMS=TEXTO
C* EVAL SMS1_CODSMS=SMS_CODSMS
C WRITE SMSPF02R
C ENDSR
*--*******************************************************************
*- Rutina de inicio de PGM
*--*******************************************************************
C *INZSR BEGSR
*
C KEYSMS KLIST
C KFLD TIPCOB1
C KFLD DIASV1
C
C *ENTRY PLIST
C PARM DESD 8
*
C MOVE DESD DESDE
*
C MOVE '0' TRUE 1
C DESDE IFEQ 0
C MOVE *DATE DESDE
C ELSE
C CALL 'SRPD01'
C PARM DESD
C PARM TRUE
C ENDIF
C MOVE TRUE *INLR
C MOVE TRUE *IN01
*
C *IN01 IFEQ *OFF
C MOVE DIADES DIAINV
C MOVE MESDES MESINV
C MOVE AÑODES AÑOINV
*--
C MOVE DIADES DIAFE2
C MOVE MESDES MESFE2
C MOVE AÑODES ANOFE2
*--
C MOVE *DATE FECHOY 8 0
C ENDIF
*Invierte las fechas
C *EUR MOVE DESDE AAAAMMDD1
*-
C *EUR TEST (D) FECHA2 36
C *EUR MOVE FECHA2 XFEC2
C XFEC2 ADDDUR 5:*D XFEC1R
C XFEC2 SUBDUR 5:*D XFEC2R
C MOVE XFEC1R FEC4
C *EUR MOVE FEC4 AAAAMMDD2
C MOVE AAAAMMDD2 AAAAMMDD3
C
//carga sql 1
C EXSR CARGA_SQL
//Crear archivo de trabajo
C EXSR ARC_TRA
//cierre de cursor
C EXSR CLOSE_CUR
C
C ENDSR
*-********************************************************************
*-llenado de archivo de trabajo
*-********************************************************************
C ARC_TRA BEGSR
//lee 1er registro
C EXSR LEE_REGIS
C
C DOW SQLCOD = 0
C
C EVAL SMST_NRREG=SNRREG
C EVAL SMST_NRGIR=SNRGIR
C EVAL SMST_AÑVCT=SAÑVCT
C EVAL SMST_MEVCT=SMEVCT
C EVAL SMST_DIVCT=SDIVCT
C EVAL SMST_MONGI=SMONGI
C EVAL SMST_CDCON=SCDCON
C EVAL SMST_TELEFO=SQLTELEFONO
C EVAL SMST_CDZNA=SZONAT
C
C WRITE SMSTEMR
C EXSR LEE_REGIS
C ENDDO
C
C ENDSR
*-********************************************************************
*-genero el select para el sql y open al cursor
*-********************************************************************
C CARGA_SQL BEGSR
C/EXEC SQL
C+ DECLARE CUR SCROLL CURSOR FOR
C+ select
C+ (case when trim(SUBSTRING(CAST (a.TELDE as
C+ character(12)),1,3))='414'
C+ and
C+ length(trim(CAST (a.TELDE as character(12))))=10
C+ or
C+ trim(SUBSTRING(CAST (a.TELDE as
C+ character(12)),1,3))='424'
C+ and
C+ length(trim(CAST (a.TELDE as character(12))))=10
C+ or
C+ trim(SUBSTRING(CAST (a.TELDE as
C+ character(12)),1,3))='416'
C+ and
C+ length(trim(CAST (a.TELDE as character(12))))=10
C+ or
C+ trim(SUBSTRING(CAST (a.TELDE as
C+ character(12)),1,3))='426'
C+ and
C+ length(trim(CAST (a.TELDE as character(12))))=10
C+ or
C+ trim(SUBSTRING(CAST (a.TELDE as
C+ character(12)),1,3))='412'
C+ and
C+ length(trim(CAST (a.TELDE as character(12))))=10
C+ then
C+ CAST (a.TELDE as character(12))
C+ else
C+
C+ (case when trim(SUBSTRING(CAST (a.TELF as
C+ character(12)),1,3))='414'
C+ and
C+ length(trim(CAST (a.TELF as character(12))))=10
C+ or
C+ trim(SUBSTRING(CAST (a.TELF as
C+ character(12)),1,3))='424'
C+ and
C+ length(trim(CAST (a.TELF as character(12))))=10
C+ or
C+ trim(SUBSTRING(CAST (a.TELF as
C+ character(12)),1,3))='416'
C+ and
C+ length(trim(CAST (a.TELF as character(12))))=10
C+ or
C+ trim(SUBSTRING(CAST (a.TELF as
C+ character(12)),1,3))='426'
C+ and
C+ length(trim(CAST (a.TELF as character(12))))=10
C+ or
C+ trim(SUBSTRING(CAST (a.TELF as
C+ character(12)),1,3))='412'
C+ and
C+ length(trim(CAST (a.TELF as character(12))))=10
C+ then
C+ CAST (a.TELF as character(12))
C+ else
C+ ''
C+ end)
C+ end) as sqltelefono ,
C+ b.nrreg,b.nrgir,b.aÑvct,b.mevct,b.divct,b.mongi,b.cdcon,
C+ b.CDZNA
C+ from
C+ libbf/gipf01 a ,
C+ libbf/gipf02 b
C+ where
C+ a.nrreg=b.nrreg
C+ and b.stsgi=1
C+ and b.nrgir>0
C+ AND (((b.AÑVCT*10000)+(b.MEVCT*100)+b.DIVCT)<= :AAAAMMDD3)
C+ and a.cdsts<>'9'
C+ and b.mongi>0
C+ and b.cdcon in (1,2,4)
C+ and
C+
C+ (case when trim(SUBSTRING(CAST (a.TELDE as
C+ character(12)),1,3))='414'
C+ and
C+ length(trim(CAST (a.TELDE as character(12))))=10
C+ or
C+ trim(SUBSTRING(CAST (a.TELDE as
C+ character(12)),1,3))='424'
C+ and
C+ length(trim(CAST (a.TELDE as character(12))))=10
C+ or
C+ trim(SUBSTRING(CAST (a.TELDE as
C+ character(12)),1,3))='416'
C+ and
C+ length(trim(CAST (a.TELDE as character(12))))=10
C+ or
C+ trim(SUBSTRING(CAST (a.TELDE as
C+ character(12)),1,3))='426'
C+ and
C+ length(trim(CAST (a.TELDE as character(12))))=10
C+ or
C+ trim(SUBSTRING(CAST (a.TELDE as
C+ character(12)),1,3))='412'
C+ and
C+ length(trim(CAST (a.TELDE as character(12))))=10
C+
C+ then
C+ a.TELDE
C+ else
C+ (case when trim(SUBSTRING(CAST (a.TELF as
C+ character(12)),1,3))='414'
C+ and
C+ length(trim(CAST (a.TELF as character(12))))=10
C+ or
C+ trim(SUBSTRING(CAST (a.TELF as
C+ character(12)),1,3))='424'
C+ and
C+ length(trim(CAST (a.TELF as character(12))))=10
C+ or
C+ trim(SUBSTRING(CAST (a.TELF as
C+ character(12)),1,3))='416'
C+ and
C+ length(trim(CAST (a.TELF as character(12))))=10
C+ or
C+ trim(SUBSTRING(CAST (a.TELF as
C+ character(12)),1,3))='426'
C+ and
C+ length(trim(CAST (a.TELF as character(12))))=10
C+ or
C+ trim(SUBSTRING(CAST (a.TELF as
C+ character(12)),1,3))='412'
C+ and
C+ length(trim(CAST (a.TELF as character(12))))=10
C+ then
C+ a.TELF
C+ else
C+ 0
C+ end)
C+ end)> 0
C/END-EXEC
C* and b.cdzna=0101
// apertura del cursor
C/EXEC SQL
C+ OPEN CUR
C/END-EXEC
C ENDSR
*-********************************************************************
*-cierre de cursor
*-********************************************************************
C CLOSE_CUR BEGSR
C/EXEC SQL
C+ CLOSE CUR
C/END-EXEC
C ENDSR
*--*******************************************************************
*-para obtener los datos -SIGUIENTE REGISTRO
*-********************************************************************
C LEE_REGIS BEGSR
C/EXEC SQL
C+ FETCH NEXT FROM CUR INTO :REGISTRO
C/END-EXEC
C ENDSR
0 comentarios :
Publicar un comentario