-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathRTVPGMSRCC.CLLE
96 lines (83 loc) · 4.13 KB
/
RTVPGMSRCC.CLLE
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
PGM PARM(&PGM &numero &rtnsrcf &rtnsrcl &rtnsrcm +
&rtnnbr)
dcl &pgm *char 20
dcl &numero *dec (3 0)
dcl &rtnsrcf *char 10
dcl &rtnsrcl *char 10
dcl &rtnsrcm *char 10
dcl &rtnnbr *dec (3 0)
dcl &wrtnsrcf *char 10
dcl &wrtnsrcl *char 10
dcl &wrtnsrcm *char 10
dcl &wrtnnbr *dec (3 0)
DCL &ERRORSW *LGL /* SWITCH */
DCL &MSGID *CHAR LEN(7) /* ID MSG */
DCL &MSGDTA *CHAR LEN(100) /* DATA */
DCL &MSGF *CHAR LEN(10) /* FICHIER */
DCL &MSGFLIB *CHAR LEN(10) /* BIBLI */
COPYRIGHT TEXT(Volubis)
MONMSG MSGID(CPF0000) EXEC(GOTO ERREUR)
/* CORPS DU PROGRAMME */
CHKOBJ OBJ(%SST(&pgm 11 10)/%SST(&pgm 1 10)) +
OBJTYPE(*pgm) AUT(*READ)
RTVOBJD OBJ(%SST(&PGM 11 10)/%SST(&PGM 1 10)) +
OBJTYPE(*PGM) SRCF(&WRTNSRCF) +
SRCFLIB(&WRTNSRCL) SRCMBR(&WRTNSRCM)
/* OPM */ IF COND(&WRTNSRCM *NE ' ') THEN(do)
chgvar &wrtnnbr 1
goto PARAMETRES
ENDDO
/* ILE */
/* creation du user space pour RTVPGMSRCG*/
DLTUSRSPC USRSPC(QTEMP/RTVPGMSRC)
MONMSG MSGID(CPF0000) EXEC(RCVMSG RMV(*YES))
call quscrtus parm('RTVPGMSRC QTEMP' +
'RTVPGMSRC' +
x'000000FF' +
x'00' +
'*USE' +
'user space temporaire')
/* routine RPG-IV, retrouve les coordonnées source */
CALLPRC PRC(RTVPGMSRCG) PARM(&PGM &numero +
&wrtnsrcf +
&wrtnsrcl +
&wrtnsrcm +
&wrtnnbr )
parametres:
chgvar &rtnsrcf &wrtnsrcf
monmsg mch0000 exec(do) /* parametre non envoyé */
RCVMSG MSGTYPE(*EXCP) /* sup du message */
enddo
chgvar &rtnsrcl &wrtnsrcl
monmsg mch0000 exec(do)
RCVMSG MSGTYPE(*EXCP)
enddo
chgvar &rtnsrcm &wrtnsrcm
monmsg mch0000 exec(do)
RCVMSG MSGTYPE(*EXCP)
enddo
chgvar &rtnnbr &wrtnnbr
monmsg mch0000 exec(do) /* parametre non envoyé */
RCVMSG MSGTYPE(*EXCP)
enddo
return
/*----------------------------------------*/
ERREUR: /* GESTION DES ERREURS */
/*----------------------------------------*/
IF &ERRORSW SNDPGMMSG MSGID(CPF9899) +
MSGF(QCPFMSG) MSGTYPE(*ESCAPE) /* 2EME FOIS*/
/* ARRET PGM*/
CHGVAR &ERRORSW '1' /* MISE EN PLACE DU SWITCH */
/* RENVOI DES MESSAGES DE TYPE *DIAG SI FIN ANORMALE */
DIAGMSG: RCVMSG MSGTYPE(*DIAG) MSGDTA(&MSGDTA) MSGID(&MSGID) +
MSGF(&MSGF) SNDMSGFLIB(&MSGFLIB)
IF (&MSGID *EQ ' ') GOTO EXCPMSG
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) MSGTYPE(*DIAG)
GOTO DIAGMSG /* BOUCLE SUR MESSAGES *DIAG */
/* RENVOI DU MESSAGE D'ERREUR */
EXCPMSG: RCVMSG MSGTYPE(*EXCP) MSGDTA(&MSGDTA) MSGID(&MSGID) +
MSGF(&MSGF) SNDMSGFLIB(&MSGFLIB)
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) MSGTYPE(*ESCAPE)
ENDPGM