DSPF How to use Moubtn with Pshbtnfld and pshbtnchc
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
Software/Hardware used:
AS400, RPG ILE
ASKED:
January 18, 2011 8:53 AM
UPDATED:
January 25, 2011 4:23 PM
Answer Wiki:
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 * * * *
To see all answers submitted to the Answer Wiki: View Answer History.
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
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 * * * *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 * * * *