Pgm avec commit/rollback

BoTTom |
     FJECRAN  CF  E                    WORKSTN
     FJARTICP1IF  E           K        DISK
     FJSTOCKP1UF  E           K        DISK
     F                                              KCOMIT
     I              'IMPOSSIBLE: QTE MINI-C         M1
     I              ' ATTEINTE'
     I              'IMPOSSIBLE: QTE MAXI-C         M2
     I              ' DEPASSEE'
     C           CLE1      KLIST
     C                     KFLD           LIEU1
     C                     KFLD           CODART
     C           CLE2      KLIST
     C                     KFLD           LIEU2
     C                     KFLD           CODART
      *
     C                     EXFMTFMT1
     C           *IN03     DOWEQ*OFF
     C                     EXSR VERIF
     C           *IN40     IFEQ *OFF
     C           *IN41     ANDEQ*OFF
     C           *IN42     ANDEQ*OFF
     C                     EXSR TRT
     C                     ENDIF
     C                     EXFMTFMT1
     C                     ENDDO
     C                     MOVE *ON       *INLR
      *
     C           VERIF     BEGSR
     C           CODART    CHAINJARTICF1             40
     C           *IN40     IFEQ *OFF
     C           CLE1      CHAINJSTOCKF1            N41
     C           *IN41     IFEQ *OFF
     C                     Z-ADDQTESTO    AQTES1
     C           CLE2      CHAINJSTOCKF1            N42
     C           *IN42     IFEQ *OFF
     C                     Z-ADDQTESTO    AQTES2
     C                     ENDIF
     C                     ENDIF
     C                     ENDIF
     C                     ENDSR
      *
     C           TRT       BEGSR
     C                     MOVE *BLANK    MSG
     C           AQTES1    SUB  QTETFR    NQTES1


|
     C           AQTES2    ADD  QTETFR    NQTES2
     C           NQTES1    IFLT QTEMIN
     C                     MOVELM1        MSG
     C                     ENDIF
     C           NQTES2    IFGT QTEMAX
     C                     MOVELM2        MSG
     C                     ENDIF
     C           MSG       IFNE *BLANK
     C                     EXFMTFMT2
     C                     ELSE
     C                     WRITEFMT2
     C                     EXSR MAJ
     C                     ENDIF
     C                     ENDSR
      *
     C           MAJ       BEGSR
     C           CLE1      CHAINJSTOCKF1             41
     C                     SUB  QTETFR    QTESTO
     C  N41                UPDATJSTOCKF1
     C           CLE2      CHAINJSTOCKF1             42
     C                     ADD  QTETFR    QTESTO
     C  N42                UPDATJSTOCKF1
     C                     EXFMTFMT3
     C           *IN12     IFNE *ON
     C                     COMIT
     C                     ELSE
     C                     ROLBK
     C                     ENDIF
     C                     ENDSR




©AF400