DSPF How to use Moubtn with Pshbtnfld and pshbtnchc

35 pts.
Tags:
AS/400
DSPF
RPG ILE
RPG ILE subprocedure
Hi, I have a DSPF with two format FMT01, FMTCM. In FMT01 I have defined MOUBTN(*ULP CF21) so when I push left button of the mouse on a specific field, *INKV(CF21) is activated and the program RPGILE do a call to a window.In FMTCM that is used as feet of the DSPF I have defined PSHBTNFLD with PSHBTNCHC(1 'F12-Exit' CA12).So when I pushed the left button of the mouse with single click over the F12 "Button" the program close. Well. this is not what happen. When I push the mouse button on F12 the *INKV(CF21) key is activated, even if I'm on FMTCM and the program do the operations for this key. Then is activate the CA12 and the program do the operations for this command. Is there a way to make the rpgle pgm understand that I'm pushing the botton of CA12 in FMTCM and I don't want to activate the *INKV of the Moubtn? Thank you

Software/Hardware used:
AS400, RPG ILE

Answer Wiki

Thanks. We'll let you know when a new response is added.

Hi
These are the sources
<b>DSPF</b>
A*********************
A* MOUBTN
A* *URP = Tasto Destro Click Singolo
A* *URD = Tasto Destro Click Doppio
A* *ULP = Tasto Sinistro Click Singolo
A* *ULD = Tasto Sinistro Click Doppio
A* *URR = Tasto Destro Click al rilascio
A* *ULR = Tasto Sinistro Click al rilascio
A*
A* Elenco Messaggi di errore usati
A* GEP0001 Scelta non Valida
A* GEP0075 Codice Dipendente Non valido o Non Esistente
A*
A*********************
A*%%EC
A DSPSIZ(27 132 *DS4)
A CHGINPDFT(CS)
A PRINT
A CF08
A CA12
A R FMT01
A KEEP
A OVERLAY
A PUTOVR
A RTNCSRLOC(*RECNAME&RCD &FLD &POS)
A RTNCSRLOC(*MOUSE &LIN &COL)
A MOUBTN(*ULP CF21)
A MOUBTN(*URP CF22)
A RCD 10A H
A FLD 10A H
A POS 4S 0H
A LIN 3S 0H
A COL 3S 0H
A VCOGNO 32A H
A VNOME 18A H
A 1 2USER
A VINTES 48A O 1 43DSPATR(HI)
A DSPATR(UL)
A VPGMNM 10A O 1122
A 2 2′ –
A –
A –
A ‘
A DSPATR(UL)
A 9 6’Dipendente’
A DSPATR(HI)
A VCDDIP 4A B 9 20OVRDTA
A OVRATR
A 81 DSPATR(PR)
A N81 DSPATR(CS)
A 30
AO 31 DSPATR(RI)
A 30
AO 31 DSPATR(PC)
A CHECK(RZ)
A VRSDIP 50A O 9 27OVRDTA
A 11 6’Società’
A DSPATR(HI)
A VCDSOC 2A O 11 20OVRDTA
A COLOR(BLU)
A VDSSOC 50A O 11 27OVRDTA
A 15 6’Scelta’
A DSPATR(HI)
A VSCELT 2A B 15 20OVRDTA
A OVRATR
A 81 DSPATR(PR)
A N81 DSPATR(CS)
A 32 DSPATR(RI)
A 32 DSPATR(PC)
A CHECK(RB)
A* CHECK(ER)
A 15 27’1)’
A COLOR(BLU)
A VSCE_01 17A O 15 30OVRDTA
A 16 27’2)’
A COLOR(BLU)
A VSCE_02 17A O 16 30OVRDTA
A 17 27’3)’
A COLOR(BLU)
A VSCE_03 17A O 17 30OVRDTA
A 18 27’4)’
A COLOR(BLU)
A VSCE_04 17A O 18 30OVRDTA
A 19 27’5)’
A COLOR(BLU)
A VSCE_05 17A O 19 30OVRDTA
A R FMTCM
A KEEP
A OVERLAY
A PUTOVR
A VCMEN 15A P
A VCM08 15A P
A VCM12 15A P
A VMSGER 130 O 25 2OVRDTA
A DSPATR(UL)
A 90 DSPATR(HI)
A CMD 2Y 0B 26 2PSHBTNFLD
A PSHBTNCHC(1 &VCMEN)
A PSHBTNCHC(3 &VCM08 CF08)
A PSHBTNCHC(6 &VCM12 CA12)
* * * * F I N E O R I G I N E * * * *
<b>RPGLE</b>
H*—————————————————————–
H* $G012
H*——————————————- MM ——————
H DECEDIT(‘0,’) DATEDIT(*YMD.) DATFMT(*ISO) TIMFMT(*JIS)
H*—————————————————————–
H* GEP – Gestione Dati Dipendente – Call Standard
H*—————————————————————–
F$G01200V CF E WORKSTN INFDS(INFO)
F*
F$GDIP03L IF E K DISK
F$GRAP01L IF E K DISK
F$GTSOC0F IF E K DISK
FTABLE01L IF E K DISK
F$GXXX00F IF E K DISK
D*
D*—————————————————————–
D* Definizione schiere e tabelle
D §§I S 1 DIM(48)
D*—————————————————————–
D* Definizione parametri
D$G012DS DS 512 DTAARA(*LDA)
D*
D$GPARM DS
D PSCEL 2A
D PDSCE 17A
D PCDDI LIKE(AA_CDIP)
D PCOGN LIKE(AA_COGN)
D PNOME LIKE(AA_NOME)
D PCDSO LIKE(AA_CDSO)
D PINDX LIKE(AA_INDX)
D PEXIT 1A
D*
D*—————————————————————–
D* Definizione strutture dati esterne
D*—————————————————————–
D* Definizione strutture dati interne
DSCELT_0001 DS
DSC_SCE 17 DIM(6)
D VSCE_01 1 17
D C_SCE01 1 17
D VSCE_02 18 34
D C_SCE02 18 34
D VSCE_03 35 51
D C_SCE03 35 51
D VSCE_04 52 68
D C_SCE04 52 68
D VSCE_05 69 85
D C_SCE05 69 85
D*
DCOMND_0001 DS
D VCMEN 1 15
D VCM08 16 30
D VCM12 31 45
D VCM11 46 60
D*
D*—————————————————————–
D* Definizione interna data area
D*—————————————————————–
D* Definizione strutture dati di sistema
DINFO DS
D* Posizione del cursore
D RIGCOL 370 371B 0
D* Numero relativo di record subfile
D NRRSFL 378 379B 0
D*
DSTATO SDS
D XPGMNM 1 10
D $PGMNM 1 6
D XUSRNM 254 263
D*—————————————————————–
D* Definizione campi interni
D ER S 2S 0 INZ(0)
D FMT S 5A INZ(‘ ‘)
D J_CDTAB S 10A
D J_OKRIC S 1A
D P_CDOP S 4A
D P_DSOP S 50A
D P_ERRCODE S 7A INZ(‘GEP0000′)
D P_LIBMSGF S 10A INZ(‘*LIBL ‘)
D P_MSGFIL S 10A INZ(‘IMPMSGF ‘)
D P_MSGRET S 240A
D P_MSGVAR S 150A
D P_TIPOO S 1A
D $$ S 2S 0 INZ(0)
D*
D J_CDDIP S LIKE(AA_CDIP)
D §_PGMXX S LIKE(XX_PGM)
D §_KEYXX S LIKE(XX_KEY)
D §_LANXX S LIKE(XX_LAN)
C*
C*******************************************-
C* CORPO DEL PGM *
C******************************
C*
C EXSR INIPRO
C*
C DOW FMT <> ‘FINE ‘
C*
C DOW FMT = ‘FMT01′
C EXSR GFMT01
C ENDDO
C*
C ENDDO
C*
C EXSR FINPRO
C*
C SETON LR
C*
C*——————————————*———————-
C* INIPRO SR –
C*—————————–
C*
C INIPRO BEGSR
C*
C K$GXXX KLIST
C KFLD §_PGMXX
C KFLD §_KEYXX
C KFLD §_LANXX
C*
C* Centratura titolo
C MOVE ‘XX’ §§FMTN
C EXSR Z0040
C MOVE §§INTE VINTES
C*
C MOVEL XPGMNM VPGMNM
C* Scelte
C MOVEL(P) XPGMNM §_PGMXX
C MOVEL ‘SCELT_0001′ §_KEYXX
C K$GXXX CHAIN $GXXX
C IF %FOUND
C MOVEL XX_DAT SCELT_0001
C ENDIF
C* Tasti Comando
C MOVEL(P) XPGMNM §_PGMXX
C MOVEL ‘COMND_0001′ §_KEYXX
C K$GXXX CHAIN $GXXX
C IF %FOUND
C MOVEL XX_DAT COMND_0001
C ENDIF
C*
C EXSR IFMT01
C*
C ENDSR
C*
C*——————————————*———————-
C* IFMT01 SR –
C*—————————–
C*
C IFMT01 BEGSR
C*
C MOVEL ‘FMT01′ FMT
C*
C ENDSR
C*
C*——————————————*———————-
C* GFMT01 SR –
C*—————————–
C*
C GFMT01 BEGSR
C*
C WRITE FMTCM
C EXFMT FMT01
C Z-ADD *ZERO ER
C SETOFF
C SETOFF 90
C CLEAR VMSGER
C*
C IF *INKL
C MOVEL ‘FINE ‘ FMT
C ENDIF
C*
C IF not *INKL and not *INKY
C EXSR RFMT01
C IF J_OKRIC=’1′
C CLEAR J_OKRIC
C ELSE
C EXSR CFMT01
C IF ER=*ZERO and not *INKH
C EXSR CHIAMA
C ENDIF
C ENDIF
C ENDIF
C*
C ENDSR
C*
C*——————————————*———————-
C* RFMT01 SR –
C*—————————–
C*
C RFMT01 BEGSR
C*
C* Window Dipendenti.
C IF VCDDIP=’?’ or VCDDIP=’!’ or
C (*INKW and FLD=’VCDDIP’) or
C (*INKV and FLD=’VCDDIP’)
C MOVEL ‘1’ J_OKRIC
C MOVEL VCDDIP P_CDOP
C MOVEL *BLANK P_DSOP
C MOVEL *BLANK P_TIPOO
C IF *INKW or VCDDIP=’?’
C MOVEL ‘1’ P_TIPOO
C ENDIF
C IF *INKV or VCDDIP=’!’
C MOVEL ‘2’ P_TIPOO
C ENDIF
C CALL ‘$G091′
C PARM P_CDOP
C PARM P_DSOP
C PARM P_TIPOO
C IF P_CDOP<>*BLANK
C MOVEL(P) P_CDOP VCDDIP
C MOVEL(P) P_DSOP VRSDIP
C MOVEL VCDDIP J_CDDIP
C J_CDDIP CHAIN $GDIP
C MOVEL AA_CDSO VCDSOC
C MOVEL(P) VCDSOC J_CDTAB
C J_CDTAB CHAIN $GTSOC
C IF not %FOUND
C MOVEL *ALL’?’ VDSSOC
C ELSE
C MOVEL T3_DSOC VDSSOC
C ENDIF
C ENDIF
C ENDIF
C*
C IF *INKW AND FLD=’VSCELT’
C MOVEL ‘1’ J_OKRIC
C CALL ‘$G0121′
C PARM SCE 2
C IF SCE<>*BLANK
C MOVE SCE VSCELT
C ‘0’:’ ‘ XLATE VSCELT VSCELT
C ENDIF
C ENDIF
C*
C IF %SUBST(FLD:1:5)=’VSCE_’ and *INKV
C MOVEL ‘1’ J_OKRIC
C EVAL VSCELT=%SUBST(FLD:6:2)
C ‘0’:’ ‘ XLATE VSCELT VSCELT
C ENDIF
C*
C ENDSR
C*
C*——————————————*———————-
C* CFMT01 SR –
C*—————————–
C*
C CFMT01 BEGSR
C*
C Z-ADD *ZERO ER
C SETOFF
C* Dipendente
C IF ER=0
C IF VCDDIP=*BLANK
C Z-ADD 30 ER
C MOVEL *ALL’?’ VRSDIP
C ENDIF
C ENDIF
C IF ER=0
C MOVEL VCDDIP J_CDDIP
C J_CDDIP CHAIN $GDIP
C IF not %FOUND
C Z-ADD 31 ER
C MOVEL *ALL’?’ VRSDIP
C ELSE
C EVAL VRSDIP=%TRIM(AA_COGN)+’ ‘+AA_NOME
C MOVEL AA_COGN VCOGNO
C MOVEL AA_NOME VNOME
C MOVEL AA_CDSO VCDSOC
C MOVEL(P) VCDSOC J_CDTAB
C J_CDTAB CHAIN $GTSOC
C IF not %FOUND
C MOVEL *ALL’?’ VDSSOC
C ELSE
C MOVEL T3_DSOC VDSSOC
C ENDIF
C ENDIF
C ENDIF
C*
C IF ER = *ZERO
C IF VSCELT<‘ 1′ OR VSCELT>’ 5′
C Z-ADD 32 ER
C ENDIF
C ENDIF
C* Gestione dell’eventuale errore
C IF ER <> *ZERO
C MOVEL *ON *IN(ER)
C SETON 90
C EXSR SETMSG
C ENDIF
C*
C ENDSR
C*
C*——————————————*———————-
C* FINPRO SR –
C*—————————–
C*
C FINPRO BEGSR
C*
C*
C ENDSR
C*
C*——————————————*———————-
C* SETMSG SR –
C*—————————–
C*
C SETMSG BEGSR
C*
C SELECT
C* Dipendente Non Valido
C WHEN ER=30 or ER=31
C EVAL %SUBST(P_ERRCODE:4:4)=’0075′
C* Scelta Non Valida
C WHEN ER=32
C EVAL %SUBST(P_ERRCODE:4:4)=’0001′
C*
C ENDSL
C*
C CALL ‘$U050′
C PARM P_MSGFIL
C PARM P_LIBMSGF
C PARM P_ERRCODE
C PARM P_MSGRET
C PARM P_MSGVAR
C MOVEL P_MSGRET VMSGER
C*
C ENDSR
C*
C*——————————————*———————-
C* CHIAMA SR –
C*—————————–
C*
C CHIAMA BEGSR
C*
C MOVEL VCDDIP J_CDDIP
C J_CDDIP CHAIN $GRAP
C SELECT
C WHEN not %FOUND and(VSCELT>=’ 1′ and
C VSCELT<=’ 4′)
C MOVEL(P) ‘ 5′ VSCELT
C ENDSL
C*
C CLEAR $GPARM
C MOVEL VSCELT PSCEL
C MOVEL VSCELT $$
C MOVE SC_SCE($$) PDSCE
C MOVEL VCDDIP PCDDI
C MOVEL(P) VCOGNO PCOGN
C MOVEL(P) VNOME PNOME
C MOVEL(P) VCDSOC PCDSO
C MOVEL $GPARM $G012DS
C OUT $G012DS
C CALL ‘$G007′
C IN $G012DS
C MOVEL $G012DS $GPARM
C IF PEXIT=’1′
C MOVEL(P) ‘FMT01′ FMT
C ENDIF
C IF PEXIT=’2′
C MOVEL(P) ‘FINE ‘ FMT
C ENDIF
C*
C ENDSR
C*
C*—————————————————————–
/COPY QRPGLESRC,Z0040 REP.TITOLO
* * * * F I N E O R I G I N E * * * *

Discuss This Question: 3  Replies

 
There was an error processing your information. Please try again later.
Thanks. We'll let you know when a new response is added.
Send me notifications when members answer or reply to this question.

REGISTER or login:

Forgot Password?
By submitting you agree to receive email from TechTarget and its partners. If you reside outside of the United States, you consent to having your personal data transferred to and processed in the United States. Privacy
  • TomLiotta
    When I push the mouse button on F12
    • the *INKV(CF21) key is activated, even if I'm on FMTCM and the program do the operations for this key.
    • Then is activate the CA12 and the program do the operations for this command.
    The way I read that, it looks as if you are saying that CF21 and CA12 are on at the same time or that they both come on though one comes on after the other. Can you clarify that? Is there a way to make the rpgle pgm understand that I'm pushing the botton of CA12 in FMTCM and I don't want to activate the *INKV of the Moubtn? Without seeing the DDS and the program code that handles the I/O, there's no way to tell. Even if the two command indicators both come on, we can't tell what your program would do without seeing the code. Tom
    125,585 pointsBadges:
    report
  • Marzio
    Hi These are the source of the DSPF and RPGLE.
      SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 
        100      A*%%TS  SD  20101227  155933  MARZARIM    REL-V6R1M0  5761-WDS                                             
        200      A*********************                                                                                     
        300      A* MOUBTN                                                                                                  
        400      A* *URP = Tasto Destro Click Singolo                                                                       
        500      A* *URD = Tasto Destro Click Doppio                                                                        
        600      A* *ULP = Tasto Sinistro Click Singolo                                                                     
        700      A* *ULD = Tasto Sinistro Click Doppio                                                                      
        800      A* *URR = Tasto Destro Click al rilascio                                                                   
        900      A* *ULR = Tasto Sinistro Click al rilascio                                                                 
       1000      A*                                                                                                         
       1100      A* Elenco Messaggi di errore usati                                                                         
       1200      A* GEP0001  Scelta non Valida                                                                              
       1300      A* GEP0075  Codice Dipendente Non valido o Non Esistente                                                   
       1400      A*                                                                                                         
       1500      A*********************                                                                                     
       1600      A*%%EC                                                                                                     
       1700      A                                      DSPSIZ(27 132 *DS4)                                                 
       1800      A                                      CHGINPDFT(CS)                                                       
       1900      A                                      PRINT                                                               
       2000      A                                      CF08                                                                
       2100      A                                      CA12                                                                
       2200      A          R FMT01                                                                                         
       2300      A*%%TS  SD  20101227  155933  MARZARIM    REL-V6R1M0  5761-WDS                                             
       2400      A                                      KEEP                                                                
       2500      A                                      OVERLAY                                                             
       2600      A                                      PUTOVR                                                              
       2700      A                                      RTNCSRLOC(*RECNAME&RCD &FLD   				       			     &POS)         
       2800      A                                      RTNCSRLOC(*MOUSE &LIN &COL)                                         
       2900      A                                      MOUBTN(*ULP CF21)                                                   
       3000      A                                      MOUBTN(*URP CF22)                                                   
       3100      A            RCD           10A  H                                                                          
       3200      A            FLD           10A  H                                                                          
       3300      A            POS            4S 0H                                                                          
       3400      A            LIN            3S 0H                                                                          
       3500      A            COL            3S 0H                                                                          
       3600      A            VCOGNO        32A  H                                                                          
       3700      A            VNOME         18A  H                                                                          
       3800      A                                  1  2USER                                                                
       3900      A            VINTES        48A  O  1 43DSPATR(HI)                                                          
       4000      A                                      DSPATR(UL)                                                          
       4100      A            VPGMNM        10A  O  1122                                                                    
       4200      A                                  2  2'                         -                                
       4300      A                                                                -                                
       4400      A                                                                -                                
       4500      A                                                                '                                         
       4600      A                                      DSPATR(UL)                                                          
       4700      A                                  9  6'Dipendente'                                                        
       4800      A                                      DSPATR(HI)                                                          
       4900      A            VCDDIP         4A  B  9 20OVRDTA                                                              
       5000      A                                      OVRATR                                                              
       5100      A  81                                  DSPATR(PR)                                                          
       5200      A N81                                  DSPATR(CS)                                                          
       5300      A  30                                                                                                      
       5400      AO 31                                  DSPATR(RI)                                                          
       5500      A  30                                                                                                      
       5600      AO 31                                  DSPATR(PC)                                                          
       5700      A                                      CHECK(RZ)                                                           
       5800      A            VRSDIP        50A  O  9 27OVRDTA                                                              
       5900      A                                 11  6'Società'                                                           
       6000      A                                      DSPATR(HI)                                                          
       6100      A            VCDSOC         2A  O 11 20OVRDTA                                                              
       6200      A                                      COLOR(BLU)                                                          
       6300      A            VDSSOC        50A  O 11 27OVRDTA                                                              
       6400      A                                 15  6'Scelta'                                                            
       6500      A                                      DSPATR(HI)                                                          
       6600      A            VSCELT         2A  B 15 20OVRDTA                                                              
       6700      A                                      OVRATR                                                              
       6800      A  81                                  DSPATR(PR)                                                          
       6900      A N81                                  DSPATR(CS)                                                          
       7000      A  32                                  DSPATR(RI)                                                          
       7100      A  32                                  DSPATR(PC)                                                          
       7200      A                                      CHECK(RB)                                                           
       7300      A*                                     CHECK(ER)                                                           
       7400      A                                 15 27'1)'                                                                
       7500      A                                      COLOR(BLU)                                                          
       7600      A            VSCE_01       17A  O 15 30OVRDTA                                                              
       7700      A                                 16 27'2)'                                                                
       7800      A                                      COLOR(BLU)                                                          
       7900      A            VSCE_02       17A  O 16 30OVRDTA                                                              
       8000      A                                 17 27'3)'                                                                
       8100      A                                      COLOR(BLU)                                                          
       8200      A            VSCE_03       17A  O 17 30OVRDTA                                                              
       8300      A                                 18 27'4)'                                                                
       8400      A                                      COLOR(BLU)                                                          
       8500      A            VSCE_04       17A  O 18 30OVRDTA                                                              
       8600      A                                 19 27'5)'                                                                
       8700      A                                      COLOR(BLU)                                                          
       8800      A            VSCE_05       17A  O 19 30OVRDTA                                                              
       8900      A          R FMTCM                                                                                         
       9000      A*%%TS  SD  20101224  113733  MARZARIM    REL-V6R1M0  5761-WDS                                             
       9100      A                                      KEEP                                                                
       9200      A                                      OVERLAY                                                             
       9300      A                                      PUTOVR                                                              
       9400      A            VCMEN         15A  P                                                                          
       9500      A            VCM08         15A  P                                                                          
       9600      A            VCM12         15A  P                                                                          
       9700      A            VMSGER       130   O 25  2OVRDTA                                                              
       9800      A                                      DSPATR(UL)                                                          
       9900      A  90                                  DSPATR(HI)                                                          
      10000      A            CMD            2Y 0B 26  2PSHBTNFLD                                                           
      10100      A                                      PSHBTNCHC(1 &VCMEN)                                                 
      10200      A                                      PSHBTNCHC(3 &VCM08 CF08)                                            
      10300      A                                      PSHBTNCHC(6 &VCM12 CA12)                                            
                                      * * * *  F I N E    O R I G I N E * * * *
    
       100      H*-----------------------------------------------------------------
        200      H* $G012                                                                      
        300      H*------------------------------------------- MM ------------------
        400      H DECEDIT('0,') DATEDIT(*YMD.) DATFMT(*ISO) TIMFMT(*JIS)                                                   
        500      H*-----------------------------------------------------------------
        600      H* GEP - Gestione Dati Dipendente - Call Standard                                                          
        700      H*-----------------------------------------------------------------
        800      H* Commenti generali al programma                                                                          
        900      H*                                                                                                         
       1000      H* Costanti Video e Tasti di Comando:                                                                      
       1100      H* File $GXXX00F                                                                                           
       1200      H*                                                                                                         
       1300      H* Indicatori usati :                                                                                      
       1400      H*                                                                                                         
       1500      H*-----------------------------------------------------------------
       1600      F$G01200V  CF   E             WORKSTN INFDS(INFO)                                                          
       1700      F*                                                                                                         
       1800      F$GDIP03L  IF   E           K DISK                                                                         
       1900      F$GRAP01L  IF   E           K DISK                                                                         
       2000      F$GTSOC0F  IF   E           K DISK                                                                         
       2100      FTABLE01L  IF   E           K DISK                                                                         
       2200      F$GXXX00F  IF   E           K DISK                                                                         
       2300      D*                                                                                                         
       2400      D*-----------------------------------------------------------------
       2500      D* Definizione schiere e tabelle                                                                           
       2600      D §§I             S              1    DIM(48)                              
       2700      D*-----------------------------------------------------------------
       2800      D* Definizione parametri                                                                                   
       2900      D$G012DS          DS           512    DTAARA(*LDA)                                                         
       3000      D*                                                                                                         
       3100      D$GPARM           DS                                                                                       
       3200      D PSCEL                          2A                                                                        
       3300      D PDSCE                         17A                                                                        
       3400      D PCDDI                               LIKE(AA_CDIP)                                                        
       3500      D PCOGN                               LIKE(AA_COGN)                                                        
       3600      D PNOME                               LIKE(AA_NOME)                                                        
       3700      D PCDSO                               LIKE(AA_CDSO)                                                        
       3800      D PINDX                               LIKE(AA_INDX)                                                        
       3900      D PEXIT                          1A                                                                        
       4000      D*                                                                                                         
       4100      D*-----------------------------------------------------------------
       4200      D* Definizione strutture dati esterne                                                                      
       4300      D*-----------------------------------------------------------------
       4400      D* Definizione strutture dati interne                                                                      
       4500      DSCELT_0001       DS                                                                                       
       4600      DSC_SCE                         17    DIM(6)                                                               
       4700      D VSCE_01                 1     17                                                                         
       4800      D  C_SCE01                1     17                                                                         
       4900      D VSCE_02                18     34                                                                         
       5000      D  C_SCE02               18     34                                                                         
       5100      D VSCE_03                35     51                                                                         
       5200      D  C_SCE03               35     51                                                                         
       5300      D VSCE_04                52     68                                                                         
       5400      D  C_SCE04               52     68                                                                         
       5500      D VSCE_05                69     85                                                                         
       5600      D  C_SCE05               69     85                                                                         
       5700      D*                                                                                                         
       5800      DCOMND_0001       DS                                                                                       
       5900      D VCMEN                   1     15                                                                         
       6000      D VCM08                  16     30                                                                         
       6100      D VCM12                  31     45                                                                         
       6200      D VCM11                  46     60                                                                         
       6300      D*                                                                                                         
       6400      D*-----------------------------------------------------------------
       6500      D* Definizione interna data area                                                                           
       6600      D*-----------------------------------------------------------------
       6700      D* Definizione strutture dati di sistema                                                                   
       6800      DINFO             DS                                                                                       
       6900      D* Posizione del cursore                                                                                   
       7000      D  RIGCOL               370    371B 0                                                                      
       7100      D* Numero relativo di record subfile                                                                       
       7200      D  NRRSFL               378    379B 0                                                                      
       7300      D*                                                                                                         
       7400      DSTATO           SDS                                                                                       
       7500      D  XPGMNM                 1     10                                                                         
       7600      D  $PGMNM                 1      6                                                                         
       7700      D  XUSRNM               254    263                                                                         
       7800      D*-----------------------------------------------------------------
       7900      D* Definizione campi interni                                                                               
       8000      D ER              S              2S 0 INZ(0)                                                               
       8100      D FMT             S              5A   INZ('     ')                                                         
       8200      D J_CDTAB         S             10A                                                                        
       8300      D J_OKRIC         S              1A                                                                        
       8400      D P_CDOP          S              4A                                                                        
       8500      D P_DSOP          S             50A                                                                        
       8600      D P_ERRCODE       S              7A   INZ('GEP0000')                                                       
       8700      D P_LIBMSGF       S             10A   INZ('*LIBL     ')                                                    
       8800      D P_MSGFIL        S             10A   INZ('IMPMSGF   ')                                                    
       8900      D P_MSGRET        S            240A                                                                        
       9000      D P_MSGVAR        S            150A                                                                        
       9100      D P_TIPOO         S              1A                                                                        
       9200      D $$              S              2S 0 INZ(0)                                                               
       9300      D*                                                                                                         
       9400      D J_CDDIP         S                   LIKE(AA_CDIP)                                                        
       9500      D §_PGMXX         S                   LIKE(XX_PGM)                                                         
       9600      D §_KEYXX         S                   LIKE(XX_KEY)                                                         
       9700      D §_LANXX         S                   LIKE(XX_LAN)                                                         
       9800      C*                                                                                                         
       9900      C*******************************************-
      10000      C*    CORPO   DEL   PGM       *                                                                            
      10100      C******************************                                                                            
      10200      C*                                                                                                         
      10300      C                   EXSR      INIPRO                                                                       
      10400      C*                                                                                                         
      10500      C                   DOW       FMT <> 'FINE '                                                               
      10600      C*                                                                                                         
      10700      C                   DOW       FMT =  'FMT01'                                                               
      10800      C                   EXSR      GFMT01                                                                       
      10900      C                   ENDDO                                                                                  
      11000      C*                                                                                                         
      11100      C                   ENDDO                                                                                  
      11200      C*                                                                                                         
      11300      C                   EXSR      FINPRO                                                                       
      11400      C*                                                                                                         
      11500      C                   SETON                                        LR                                        
      11600      C*                                                                                                         
      11700      C*------------------------------------------*----------------------
      11800      C*    INIPRO        SR        -                                                                            
      11900      C*-----------------------------                                                                            
      12000      C*                                                                                                         
      12100      C     INIPRO        BEGSR                                                                                  
      12200      C*                                                                                                         
      12300      C     K$GXXX        KLIST                                                                                  
      12400      C                   KFLD                    §_PGMXX                                                        
      12500      C                   KFLD                    §_KEYXX                                                        
      12600      C                   KFLD                    §_LANXX                                                        
      12700      C*                                                                                                         
      12800      C* Centratura titolo                                                                                       
      12900      C                   MOVE      'XX'          §§FMTN                                                         
      13000      C                   EXSR      Z0040                                                                        
      13100      C                   MOVE      §§INTE        VINTES                                                         
      13200      C*                                                                                                         
      13300      C                   MOVEL     XPGMNM        VPGMNM                                                         
      13400      C* Scelte                                                                                                  
      13500      C                   MOVEL(P)  XPGMNM        §_PGMXX                                                        
      13600      C                   MOVEL     'SCELT_0001'  §_KEYXX                                                        
      13700      C     K$GXXX        CHAIN     $GXXX                                                                        
      13800      C                   IF        %FOUND                                                                       
      13900      C                   MOVEL     XX_DAT        SCELT_0001                                                     
      14000      C                   ENDIF                                                                                  
      14100      C* Tasti Comando                                                                                           
      14200      C                   MOVEL(P)  XPGMNM        §_PGMXX                                                        
      14300      C                   MOVEL     'COMND_0001'  §_KEYXX                                                        
      14400      C     K$GXXX        CHAIN     $GXXX                                                                        
      14500      C                   IF        %FOUND                                                                       
      14600      C                   MOVEL     XX_DAT        COMND_0001                                                     
      14700      C                   ENDIF                                                                                  
      14800      C*                                                                                                         
      14900      C                   EXSR      IFMT01                                                                       
      15000      C*                                                                                                         
      15100      C                   ENDSR                                                                                  
      15200      C*                                                                                                         
      15300      C*------------------------------------------*----------------------
      15400      C*    IFMT01        SR        -                                                                            
      15500      C*-----------------------------                                                                            
      15600      C*                                                                                                         
      15700      C     IFMT01        BEGSR                                                                                  
      15800      C*                                                                                                         
      15900      C                   MOVEL     'FMT01'       FMT                                                            
      16000      C*                                                                                                         
      16100      C                   ENDSR                                                                                  
      16200      C*                                                                                                         
      16300      C*------------------------------------------*----------------------
      16400      C*    GFMT01        SR        -                                                                            
      16500      C*-----------------------------                                                                            
      16600      C*                                                                                                         
      16700      C     GFMT01        BEGSR                                                                                  
      16800      C*                                                                                                         
      16900      C                   WRITE     FMTCM                                                                        
      17000      C                   EXFMT     FMT01                                                                        
      17100      C                   Z-ADD     *ZERO         ER                                                             
      17200      C                   SETOFF                                       
      17300      C                   SETOFF                                       90                                        
      17400      C                   CLEAR                   VMSGER                                                         
      17500      C*                                                                                                         
      17600      C                   IF        *INKL                                                                        
      17700      C                   MOVEL     'FINE '       FMT                                                            
      17800      C                   ENDIF                                                                                  
      17900      C*                                                                                                         
      18000      C                   IF        not *INKL and not *INKY                                                      
      18100      C                   EXSR      RFMT01                                                                       
      18200      C                   IF        J_OKRIC='1'                                                                  
      18300      C                   CLEAR                   J_OKRIC                                                        
      18400      C                   ELSE                                                                                   
      18500      C                   EXSR      CFMT01                                                                       
      18600      C                   IF        ER=*ZERO and not *INKH                                                       
      18700      C                   EXSR      CHIAMA                                                                       
      18800      C                   ENDIF                                                                                  
      18900      C                   ENDIF                                                                                  
      19000      C                   ENDIF                                                                                  
      19100      C*                                                                                                         
      19200      C                   ENDSR                                                                                  
      19300      C*                                                                                                         
      19400      C*------------------------------------------*----------------------
      19500      C*    RFMT01        SR        -                                                                            
      19600      C*-----------------------------                                                                            
      19700      C*                                                                                                         
      19800      C     RFMT01        BEGSR                                                                                  
      19900      C*                                                                                                         
      20000      C* Window Dipendenti.                                                                                      
      20100      C                   IF        VCDDIP='?' or VCDDIP='!' or                                                  
      20200      C                             (*INKW and FLD='VCDDIP') or                                                  
      20300      C                             (*INKV and FLD='VCDDIP')                                                     
      20400      C                   MOVEL     '1'           J_OKRIC                                                        
      20500      C                   MOVEL     VCDDIP        P_CDOP                                                         
      20600      C                   MOVEL     *BLANK        P_DSOP                                                         
      20700      C                   MOVEL     *BLANK        P_TIPOO                                                        
      20800      C                   IF        *INKW or VCDDIP='?'                                                          
      20900      C                   MOVEL     '1'           P_TIPOO                                                        
      21000      C                   ENDIF                                                                                  
      21100      C                   IF        *INKV or VCDDIP='!'                                                          
      21200      C                   MOVEL     '2'           P_TIPOO                                                        
      21300      C                   ENDIF                                                                                  
      21400      C                   CALL      '$G091'                                                                      
      21500      C                   PARM                    P_CDOP                                                         
      21600      C                   PARM                    P_DSOP                                                         
      21700      C                   PARM                    P_TIPOO                                                        
      21800      C                   IF        P_CDOP<>*BLANK                                                               
      21900      C                   MOVEL(P)  P_CDOP        VCDDIP                                                         
      22000      C                   MOVEL(P)  P_DSOP        VRSDIP                                                         
      22100      C                   MOVEL     VCDDIP        J_CDDIP                                                        
      22200      C     J_CDDIP       CHAIN     $GDIP                                                                        
      22300      C                   MOVEL     AA_CDSO       VCDSOC                                                         
      22400      C                   MOVEL(P)  VCDSOC        J_CDTAB                                                        
      22500      C     J_CDTAB       CHAIN     $GTSOC                                                                       
      22600      C                   IF        not %FOUND                                                                   
      22700      C                   MOVEL     *ALL'?'       VDSSOC                                                         
      22800      C                   ELSE                                                                                   
      22900      C                   MOVEL     T3_DSOC       VDSSOC                                                         
      23000      C                   ENDIF                                                                                  
      23100      C                   ENDIF                                                                                  
      23200      C                   ENDIF                                                                                  
      23300      C*                                                                                                         
      23400      C                   IF        *INKW AND FLD='VSCELT'                                                       
      23500      C                   MOVEL     '1'           J_OKRIC                                                        
      23600      C                   CALL      '$G0121'                                                                     
      23700      C                   PARM                    SCE               2                                            
      23800      C                   IF        SCE<>*BLANK                                                                  
      23900      C                   MOVE      SCE           VSCELT                                                         
      24000      C     '0':' '       XLATE     VSCELT        VSCELT                                                         
      24100      C                   ENDIF                                                                                  
      24200      C                   ENDIF                                                                                  
      24300      C*                                                                                                         
      24400      C                   IF        %SUBST(FLD:1:5)='VSCE_' and *INKV                                            
      24500      C                   MOVEL     '1'           J_OKRIC                                                        
      24600      C                   EVAL      VSCELT=%SUBST(FLD:6:2)                                                       
      24700      C     '0':' '       XLATE     VSCELT        VSCELT                                                         
      24800      C                   ENDIF                                                                                  
      24900      C*                                                                                                         
      25000      C                   ENDSR                                                                                  
      25100      C*                                                                                                         
      25200      C*------------------------------------------*----------------------
      25300      C*    CFMT01        SR        -                                                                            
      25400      C*-----------------------------                                                                            
      25500      C*                                                                                                         
      25600      C     CFMT01        BEGSR                                                                                  
      25700      C*                                                                                                         
      25800      C                   Z-ADD     *ZERO         ER                                                             
      25900      C                   SETOFF                                       
      26000      C* Dipendente                                                                                              
      26100      C                   IF        ER=0                                                                         
      26200      C                   IF        VCDDIP=*BLANK                                                                
      26300      C                   Z-ADD     30            ER                                                             
      26400      C                   MOVEL     *ALL'?'       VRSDIP                                                         
      26500      C                   ENDIF                                                                                  
      26600      C                   ENDIF                                                                                  
      26700      C                   IF        ER=0                                                                         
      26800      C                   MOVEL     VCDDIP        J_CDDIP                                                        
      26900      C     J_CDDIP       CHAIN     $GDIP                                                                        
      27000      C                   IF        not %FOUND                                                                   
      27100      C                   Z-ADD     31            ER                                                             
      27200      C                   MOVEL     *ALL'?'       VRSDIP                                                         
      27300      C                   ELSE                                                                                   
      27400      C                   EVAL      VRSDIP=%TRIM(AA_COGN)+' '+AA_NOME                                            
      27500      C                   MOVEL     AA_COGN       VCOGNO                                                         
      27600      C                   MOVEL     AA_NOME       VNOME                                                          
      27700      C                   MOVEL     AA_CDSO       VCDSOC                                                         
      27800      C                   MOVEL(P)  VCDSOC        J_CDTAB                                                        
      27900      C     J_CDTAB       CHAIN     $GTSOC                                                                       
      28000      C                   IF        not %FOUND                                                                   
      28100      C                   MOVEL     *ALL'?'       VDSSOC                                                         
      28200      C                   ELSE                                                                                   
      28300      C                   MOVEL     T3_DSOC       VDSSOC                                                         
      28400      C                   ENDIF                                                                                  
      28500      C                   ENDIF                                                                                  
      28600      C                   ENDIF                                                                                  
      28700      C*                                                                                                         
      28800      C                   IF        ER = *ZERO                                                                   
      28900      C                   IF        VSCELT<' 1' OR VSCELT>' 5'                                                   
      29000      C                   Z-ADD     32            ER                                                             
      29100      C                   ENDIF                                                                                  
      29200      C                   ENDIF                                                                                  
      29300      C* Gestione dell'eventuale errore                                                                          
      29400      C                   IF        ER <> *ZERO                                                                  
      29500      C                   MOVEL     *ON           *IN(ER)                                                        
      29600      C                   SETON                                        90                                        
      29700      C                   EXSR      SETMSG                                                                       
      29800      C                   ENDIF                                                                                  
      29900      C*                                                                                                         
      30000      C                   ENDSR                                                                                  
      30100      C*                                                                                                         
      30200      C*------------------------------------------*----------------------
      30300      C*    FINPRO        SR        -                                                                            
      30400      C*-----------------------------                                                                            
      30500      C*                                                                                                         
      30600      C     FINPRO        BEGSR                                                                                  
      30700      C*                                                                                                         
      30800      C*                                                                                                         
      30900      C                   ENDSR                                                                                  
      31000      C*                                                                                                         
      31100      C*------------------------------------------*----------------------
      31200      C*    SETMSG        SR        -                                                                            
      31300      C*-----------------------------                                                                            
      31400      C*                                                                                                         
      31500      C     SETMSG        BEGSR                                                                                  
      31600      C*                                                                                                         
      31700      C                   SELECT                                                                                 
      31800      C* Dipendente Non Valido                                                                                   
      31900      C                   WHEN      ER=30 or ER=31                                                               
      32000      C                   EVAL      %SUBST(P_ERRCODE:4:4)='0075'                                                 
      32100      C* Scelta Non Valida                                                                                       
      32200      C                   WHEN      ER=32                                                                        
      32300      C                   EVAL      %SUBST(P_ERRCODE:4:4)='0001'                                                 
      32400      C*                                                                                                         
      32500      C                   ENDSL                                                                                  
      32600      C*                                                                                                         
      32700      C                   CALL      '$U050'                                                                      
      32800      C                   PARM                    P_MSGFIL                                                       
      32900      C                   PARM                    P_LIBMSGF                                                      
      33000      C                   PARM                    P_ERRCODE                                                      
      33100      C                   PARM                    P_MSGRET                                                       
      33200      C                   PARM                    P_MSGVAR                                                       
      33300      C                   MOVEL     P_MSGRET      VMSGER                                                         
      33400      C*                                                                                                         
      33500      C                   ENDSR                                                                                  
      33600      C*                                                                                                         
      33700      C*------------------------------------------*----------------------
      33800      C*    CHIAMA        SR        -                                                                            
      33900      C*-----------------------------                                                                            
      34000      C*                                                                                                         
      34100      C     CHIAMA        BEGSR                                                                                  
      34200      C*                                                                                                         
      34300      C                   MOVEL     VCDDIP        J_CDDIP                                                        
      34400      C     J_CDDIP       CHAIN     $GRAP                                                                        
      34500      C                   SELECT                                                                                 
               34600      C                   WHEN      not %FOUND and(VSCELT>=' 1' and                                				        VSCELT<=' 4')                                
      34700      C                   MOVEL(P)  ' 5'          VSCELT                                                         
      34800      C                   ENDSL                                                                                  
      34900      C*                                                                                                         
      35000      C                   CLEAR                   $GPARM                                                         
      35100      C                   MOVEL     VSCELT        PSCEL                                                          
      35200      C                   MOVEL     VSCELT        $$                                                             
      35300      C                   MOVE      SC_SCE($$)    PDSCE                                                          
      35400      C                   MOVEL     VCDDIP        PCDDI                                                          
      35500      C                   MOVEL(P)  VCOGNO        PCOGN                                                          
      35600      C                   MOVEL(P)  VNOME         PNOME                                                          
      35700      C                   MOVEL(P)  VCDSOC        PCDSO                                                          
      35800      C                   MOVEL     $GPARM        $G012DS                                                        
      35900      C                   OUT       $G012DS                                                                      
      36000      C                   CALL      '$G007'                                                                      
      36100      C                   IN        $G012DS                                                                      
      36200      C                   MOVEL     $G012DS       $GPARM                                                         
      36300      C                   IF        PEXIT='1'                                                                    
      36400      C                   MOVEL(P)  'FMT01'       FMT                                                            
      36500      C                   ENDIF                                                                                  
      36600      C                   IF        PEXIT='2'                                                                    
      36700      C                   MOVEL(P)  'FINE '       FMT                                                            
      36800      C                   ENDIF                                                                                  
      36900      C*                                                                                                         
      37000      C                   ENDSR                                                                                  
      37100      C*                                                                                                         
      37200      C*-----------------------------------------------------------------
      37300       /COPY QRPGLESRC,Z0040                                REP.TITOLO                                           
                                      * * * *  F I N E    O R I G I N E * * * *
    
    35 pointsBadges:
    report
  • Marzio
    Hi These are the sources of The DSPF and RPGLE A********************* A* MOUBTN A* *URP = Tasto Destro Click Singolo A* *URD = Tasto Destro Click Doppio A* *ULP = Tasto Sinistro Click Singolo A* *ULD = Tasto Sinistro Click Doppio A* *URR = Tasto Destro Click al rilascio A* *ULR = Tasto Sinistro Click al rilascio A* A* Elenco Messaggi di errore usati A* GEP0001 Scelta non Valida A* GEP0075 Codice Dipendente Non valido o Non Esistente A* A********************* A*%%EC A DSPSIZ(27 132 *DS4) A CHGINPDFT(CS) A PRINT A CF08 A CA12 A R FMT01 A KEEP A OVERLAY A PUTOVR A RTNCSRLOC(*RECNAME&RCD &FLD &POS) A RTNCSRLOC(*MOUSE &LIN &COL) A MOUBTN(*ULP CF21) A MOUBTN(*URP CF22) A RCD 10A H A FLD 10A H A POS 4S 0H A LIN 3S 0H A COL 3S 0H A VCOGNO 32A H A VNOME 18A H A 1 2USER A VINTES 48A O 1 43DSPATR(HI) A DSPATR(UL) A VPGMNM 10A O 1122 A 2 2' - A - A - A ' A DSPATR(UL) A 9 6'Dipendente' A DSPATR(HI) A VCDDIP 4A B 9 20OVRDTA A OVRATR A 81 DSPATR(PR) A N81 DSPATR(CS) A 30 AO 31 DSPATR(RI) A 30 AO 31 DSPATR(PC) A CHECK(RZ) A VRSDIP 50A O 9 27OVRDTA A 11 6'Società' A DSPATR(HI) A VCDSOC 2A O 11 20OVRDTA A COLOR(BLU) A VDSSOC 50A O 11 27OVRDTA A 15 6'Scelta' A DSPATR(HI) A VSCELT 2A B 15 20OVRDTA A OVRATR A 81 DSPATR(PR) A N81 DSPATR(CS) A 32 DSPATR(RI) A 32 DSPATR(PC) A CHECK(RB) A* CHECK(ER) A 15 27'1)' A COLOR(BLU) A VSCE_01 17A O 15 30OVRDTA A 16 27'2)' A COLOR(BLU) A VSCE_02 17A O 16 30OVRDTA A 17 27'3)' A COLOR(BLU) A VSCE_03 17A O 17 30OVRDTA A 18 27'4)' A COLOR(BLU) A VSCE_04 17A O 18 30OVRDTA A 19 27'5)' A COLOR(BLU) A VSCE_05 17A O 19 30OVRDTA A R FMTCM A KEEP A OVERLAY A PUTOVR A VCMEN 15A P A VCM08 15A P A VCM12 15A P A VMSGER 130 O 25 2OVRDTA A DSPATR(UL) A 90 DSPATR(HI) A CMD 2Y 0B 26 2PSHBTNFLD A PSHBTNCHC(1 &VCMEN) A PSHBTNCHC(3 &VCM08 CF08) A PSHBTNCHC(6 &VCM12 CA12) * * * * F I N E O R I G I N E * * * * H*----------------------------------------------------------------- H* $G012 H*------------------------------------------- MM ------------------ H DECEDIT('0,') DATEDIT(*YMD.) DATFMT(*ISO) TIMFMT(*JIS) H*----------------------------------------------------------------- H* GEP - Gestione Dati Dipendente - Call Standard H*----------------------------------------------------------------- F$G01200V CF E WORKSTN INFDS(INFO) F* F$GDIP03L IF E K DISK F$GRAP01L IF E K DISK F$GTSOC0F IF E K DISK FTABLE01L IF E K DISK F$GXXX00F IF E K DISK D* D*----------------------------------------------------------------- D* Definizione schiere e tabelle D §§I S 1 DIM(48) D*----------------------------------------------------------------- D* Definizione parametri D$G012DS DS 512 DTAARA(*LDA) D* D$GPARM DS D PSCEL 2A D PDSCE 17A D PCDDI LIKE(AA_CDIP) D PCOGN LIKE(AA_COGN) D PNOME LIKE(AA_NOME) D PCDSO LIKE(AA_CDSO) D PINDX LIKE(AA_INDX) D PEXIT 1A D* D*----------------------------------------------------------------- D* Definizione strutture dati esterne D*----------------------------------------------------------------- D* Definizione strutture dati interne DSCELT_0001 DS DSC_SCE 17 DIM(6) D VSCE_01 1 17 D C_SCE01 1 17 D VSCE_02 18 34 D C_SCE02 18 34 D VSCE_03 35 51 D C_SCE03 35 51 D VSCE_04 52 68 D C_SCE04 52 68 D VSCE_05 69 85 D C_SCE05 69 85 D* DCOMND_0001 DS D VCMEN 1 15 D VCM08 16 30 D VCM12 31 45 D VCM11 46 60 D* D*----------------------------------------------------------------- D* Definizione interna data area D*----------------------------------------------------------------- D* Definizione strutture dati di sistema DINFO DS D* Posizione del cursore D RIGCOL 370 371B 0 D* Numero relativo di record subfile D NRRSFL 378 379B 0 D* DSTATO SDS D XPGMNM 1 10 D $PGMNM 1 6 D XUSRNM 254 263 D*----------------------------------------------------------------- D* Definizione campi interni D ER S 2S 0 INZ(0) D FMT S 5A INZ(' ') D J_CDTAB S 10A D J_OKRIC S 1A D P_CDOP S 4A D P_DSOP S 50A D P_ERRCODE S 7A INZ('GEP0000') D P_LIBMSGF S 10A INZ('*LIBL ') D P_MSGFIL S 10A INZ('IMPMSGF ') D P_MSGRET S 240A D P_MSGVAR S 150A D P_TIPOO S 1A D $$ S 2S 0 INZ(0) D* D J_CDDIP S LIKE(AA_CDIP) D §_PGMXX S LIKE(XX_PGM) D §_KEYXX S LIKE(XX_KEY) D §_LANXX S LIKE(XX_LAN) C* C*******************************************- C* CORPO DEL PGM * C****************************** C* C EXSR INIPRO C* C DOW FMT <> 'FINE ' C* C DOW FMT = 'FMT01' C EXSR GFMT01 C ENDDO C* C ENDDO C* C EXSR FINPRO C* C SETON LR C* C*------------------------------------------*---------------------- C* INIPRO SR - C*----------------------------- C* C INIPRO BEGSR C* C K$GXXX KLIST C KFLD §_PGMXX C KFLD §_KEYXX C KFLD §_LANXX C* C* Centratura titolo C MOVE 'XX' §§FMTN C EXSR Z0040 C MOVE §§INTE VINTES C* C MOVEL XPGMNM VPGMNM C* Scelte C MOVEL(P) XPGMNM §_PGMXX C MOVEL 'SCELT_0001' §_KEYXX C K$GXXX CHAIN $GXXX C IF %FOUND C MOVEL XX_DAT SCELT_0001 C ENDIF C* Tasti Comando C MOVEL(P) XPGMNM §_PGMXX C MOVEL 'COMND_0001' §_KEYXX C K$GXXX CHAIN $GXXX C IF %FOUND C MOVEL XX_DAT COMND_0001 C ENDIF C* C EXSR IFMT01 C* C ENDSR C* C*------------------------------------------*---------------------- C* IFMT01 SR - C*----------------------------- C* C IFMT01 BEGSR C* C MOVEL 'FMT01' FMT C* C ENDSR C* C*------------------------------------------*---------------------- C* GFMT01 SR - C*----------------------------- C* C GFMT01 BEGSR C* C WRITE FMTCM C EXFMT FMT01 C Z-ADD *ZERO ER C SETOFF C SETOFF 90 C CLEAR VMSGER C* C IF *INKL C MOVEL 'FINE ' FMT C ENDIF C* C IF not *INKL and not *INKY C EXSR RFMT01 C IF J_OKRIC='1' C CLEAR J_OKRIC C ELSE C EXSR CFMT01 C IF ER=*ZERO and not *INKH C EXSR CHIAMA C ENDIF C ENDIF C ENDIF C* C ENDSR C* C*------------------------------------------*---------------------- C* RFMT01 SR - C*----------------------------- C* C RFMT01 BEGSR C* C* Window Dipendenti. C IF VCDDIP='?' or VCDDIP='!' or C (*INKW and FLD='VCDDIP') or C (*INKV and FLD='VCDDIP') C MOVEL '1' J_OKRIC C MOVEL VCDDIP P_CDOP C MOVEL *BLANK P_DSOP C MOVEL *BLANK P_TIPOO C IF *INKW or VCDDIP='?' C MOVEL '1' P_TIPOO C ENDIF C IF *INKV or VCDDIP='!' C MOVEL '2' P_TIPOO C ENDIF C CALL '$G091' C PARM P_CDOP C PARM P_DSOP C PARM P_TIPOO C IF P_CDOP<>*BLANK C MOVEL(P) P_CDOP VCDDIP C MOVEL(P) P_DSOP VRSDIP C MOVEL VCDDIP J_CDDIP C J_CDDIP CHAIN $GDIP C MOVEL AA_CDSO VCDSOC C MOVEL(P) VCDSOC J_CDTAB C J_CDTAB CHAIN $GTSOC C IF not %FOUND C MOVEL *ALL'?' VDSSOC C ELSE C MOVEL T3_DSOC VDSSOC C ENDIF C ENDIF C ENDIF C* C IF *INKW AND FLD='VSCELT' C MOVEL '1' J_OKRIC C CALL '$G0121' C PARM SCE 2 C IF SCE<>*BLANK C MOVE SCE VSCELT C '0':' ' XLATE VSCELT VSCELT C ENDIF C ENDIF C* C IF %SUBST(FLD:1:5)='VSCE_' and *INKV C MOVEL '1' J_OKRIC C EVAL VSCELT=%SUBST(FLD:6:2) C '0':' ' XLATE VSCELT VSCELT C ENDIF C* C ENDSR C* C*------------------------------------------*---------------------- C* CFMT01 SR - C*----------------------------- C* C CFMT01 BEGSR C* C Z-ADD *ZERO ER C SETOFF C* Dipendente C IF ER=0 C IF VCDDIP=*BLANK C Z-ADD 30 ER C MOVEL *ALL'?' VRSDIP C ENDIF C ENDIF C IF ER=0 C MOVEL VCDDIP J_CDDIP C J_CDDIP CHAIN $GDIP C IF not %FOUND C Z-ADD 31 ER C MOVEL *ALL'?' VRSDIP C ELSE C EVAL VRSDIP=%TRIM(AA_COGN)+' '+AA_NOME C MOVEL AA_COGN VCOGNO C MOVEL AA_NOME VNOME C MOVEL AA_CDSO VCDSOC C MOVEL(P) VCDSOC J_CDTAB C J_CDTAB CHAIN $GTSOC C IF not %FOUND C MOVEL *ALL'?' VDSSOC C ELSE C MOVEL T3_DSOC VDSSOC C ENDIF C ENDIF C ENDIF C* C IF ER = *ZERO C IF VSCELT<' 1' OR VSCELT>' 5' C Z-ADD 32 ER C ENDIF C ENDIF C* Gestione dell'eventuale errore C IF ER <> *ZERO C MOVEL *ON *IN(ER) C SETON 90 C EXSR SETMSG C ENDIF C* C ENDSR C* C*------------------------------------------*---------------------- C* FINPRO SR - C*----------------------------- C* C FINPRO BEGSR C* C* C ENDSR C* C*------------------------------------------*---------------------- C* SETMSG SR - C*----------------------------- C* C SETMSG BEGSR C* C SELECT C* Dipendente Non Valido C WHEN ER=30 or ER=31 C EVAL %SUBST(P_ERRCODE:4:4)='0075' C* Scelta Non Valida C WHEN ER=32 C EVAL %SUBST(P_ERRCODE:4:4)='0001' C* C ENDSL C* C CALL '$U050' C PARM P_MSGFIL C PARM P_LIBMSGF C PARM P_ERRCODE C PARM P_MSGRET C PARM P_MSGVAR C MOVEL P_MSGRET VMSGER C* C ENDSR C* C*------------------------------------------*---------------------- C* CHIAMA SR - C*----------------------------- C* C CHIAMA BEGSR C* C MOVEL VCDDIP J_CDDIP C J_CDDIP CHAIN $GRAP C SELECT C WHEN not %FOUND and(VSCELT>=' 1' and C VSCELT<=' 4') C MOVEL(P) ' 5' VSCELT C ENDSL C* C CLEAR $GPARM C MOVEL VSCELT PSCEL C MOVEL VSCELT $$ C MOVE SC_SCE($$) PDSCE C MOVEL VCDDIP PCDDI C MOVEL(P) VCOGNO PCOGN C MOVEL(P) VNOME PNOME C MOVEL(P) VCDSOC PCDSO C MOVEL $GPARM $G012DS C OUT $G012DS C CALL '$G007' C IN $G012DS C MOVEL $G012DS $GPARM C IF PEXIT='1' C MOVEL(P) 'FMT01' FMT C ENDIF C IF PEXIT='2' C MOVEL(P) 'FINE ' FMT C ENDIF C* C ENDSR C* C*----------------------------------------------------------------- /COPY QRPGLESRC,Z0040 REP.TITOLO * * * * F I N E O R I G I N E * * * *
    35 pointsBadges:
    report

Forgot Password

No problem! Submit your e-mail address below. We'll send you an e-mail containing your password.

Your password has been sent to:

To follow this tag...

There was an error processing your information. Please try again later.

REGISTER or login:

Forgot Password?
By submitting you agree to receive email from TechTarget and its partners. If you reside outside of the United States, you consent to having your personal data transferred to and processed in the United States. Privacy

Thanks! We'll email you when relevant content is added and updated.

Following