
|
.....H*eywords++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++Comments+++++++++++
H DATEDIT(*DMY)
.....F*ilename++IPEASFRlen+LKlen+AIDevice+.Keywords+++++++++++++++++++++++++++++Comments+++++++++++
FRPGI11D CF E WORKSTN
FFICH1L0 UF E K DISK
FFICH2P1 IF E K DISK
FFICH1PV UF A E K DISK
.....D*ame+++++++++++ETDsFrom+++To/L+++IDc.Keywords+++++++++++++++++++++++++++++Comments++++++++++++
D M1 C CONST('ENREGISTREMENT VERRO-
D UILLÉ PAR')
D M2 C CONST('LE :')
D SDS
D SDSECR 244 253
D DATC DS
D DATVER 1 6 0 INZ
* PGM PRINCIPAL (BOUCLE SUR IMAGE 1)
* ==================================
.....C*0N01Factor1+++++++Opcode(E)+Factor2+++++++Result++++++++Len++D+HiLoEq....Comments+++++++++++
C WRITE TITRE
C EXFMT F1
C *IN03 DOWEQ *OFF
C EXSR TRTF1
C EXFMT F1
C ENDDO
C MOVE *ON *INLR
* DEBUT DES SOUS PROGRAMMES
* =========================
C TRTF1 BEGSR
C CLE CHAIN FICH1FV 65
C *IN65 IFEQ *OFF
* ENREGISTREMENT VERROUILLÉ
C UNLOCK FICH1PV
C M1 CAT(P) ECRAN:1 MSG
C CAT M2:1 MSG
C CAT DATC:1 MSG
C MOVE *ON *IN60
C ELSE
* LECTURE SEULE --------V
C CLE CHAIN(N) FICH1F1 50
C *IN50 IFEQ *OFF
C MOVE SDSECR ECRAN
C Z-ADD UDATE DATVER
C WRITE FICH1FV
C EXSR TRTF2
|
C CLE DELETE FICH1FV 90 C ENDIF C ENDIF C ENDSR * C TRTF2 BEGSR C ERROR DOUEQ 'NON' C EXFMT F2 C SELECT C *IN12 WHENEQ *ON C LEAVE C OTHER C EXSR CTLF2 C ERROR IFEQ 'NON' * ACCES AU FICHIER EN MISE JOUR (ON PERD LA SAISIE UTILISATEUR) C CLE CHAIN FICH1F1 50 * RELECTURE DU BUFFER ECRAN (RETROUVE MISES A JOUR UTILISATEUR) * (SANS ACTION CLAVIER CAR "RTNDTA" DANS LE DSPF) C READ F2 90 * MISE A JOUR FICHIER ET DEVERROUILLAGE C UPDATE FICH1F1 C ENDIF C ENDSL C ENDDO C ENDSR * C CTLF2 BEGSR C MOVE 'NON' ERROR 3 * CONTROLE DU CODE C CODE CHAIN FICH2F1 51 C *IN51 IFEQ *ON C MOVE 'OUI' ERROR C ENDIF * AUTRES CONTROLES DE VALIDITE C* ..... IF.. ..... C* MOVE 'OUI' ERROR C* MOVE *ON *IN.. C* ENDIF C ENDSR |